c
c-----Arnold I. Boothroyd: VERSION of SEPTEMBER 7, 2007----------z5xcotrin21.f
c
c  This version (Z-interpolation parameter nz = 5): needs 9.2 Mb of storage.
c
c  Send any questions/comments/bug-reports to  boothroy@cita.utoronto.ca
c------------------------------------------------------------------------------
c  OPAL 1995: Reference: C.A. Iglesias & F.J. Rogers (1996), ApJ, 464, 943-953
c------------------------------------------------------------------------------
c  Note OPAL opacities are available at http://www-phys.llnl.gov/Research/OPAL/
c  This program is from  http://www.cita.utoronto.ca/~boothroy/kappa.html
c******************************************************************************
c  1995 OPAL opacities for arbitrary metallicity Z (in the range 0.0 to 0.1),
c  including C,O-rich opacities.  Interpolation in Z can be performed when the
c  opacities are read in and/or when the opacity-calculation routine is called;
c  this choice is under user control.  It is possible to obtain opacities at
c  arbitrary values of [O/Fe] by using the non-CO-rich opacity files 'GN93hz'
c  and (one of) 'Alrd96a2', 'C95hz', or 'W95hz' (but this can only be done at
c  the time when the opacities are being read in, not subseqently when the
c  opacity-calculation routine is called).  Arbitrary hydrogen abundances and
c  arbitrary amounts of excess carbon and oxygen are always allowed.  Uses the
c  40 OPAL opacity files  Gz???.x??  (also checks for earlier names  Gx??z* ).
c--ALSO: accurate opacity values can be interpolated as a function of varying
c  relative C, N, O, and Ne abundances (and/or a user-specified element).
c--ALSO: molecular opacities may be read in and used (at low T).
c--ALSO: conductive opacities may be read in and used (at high density).
c******************************************************************************
c  Based on the old OPAL routines xcotrin.f and xcotrinz.f, modified to use
c  the new (1995) opacity tables Gz???x?? and GN93hz --- similar to xcotrin21.f
c  (but with a significantly different interface, as described further below).
c******************************************************************************
c
c------------------------------------------------------------------------------
c*** UPDATED SEPTEMBER 7, 2007: from version of AUGUST 26, 2007:
c --Added automatic handling of the new alpha-enhanced GS98 molecular opacities
c that are now available from  http://webs.wichita.edu/physics/opacity/
c------------------------------------------------------------------------------
c*** UPDATED AUGUST 26, 2007: from version of APRIL 6, 2007:
c --Fixed a bug so that FZEDGE is now set correctly to 0.0 for Z out-of-range
c (previous version incorrectly set FZEDGE = 1.0 in such a case, and returned
c the conductive opacity [if available], rather than a value of 1.0E+35 to
c indicate that the opacity could not be computed; this bug is now fixed).
c --Smoother switch-off of non-exC,O-opacity-shifts for 0.2 < exC+exO < 0.3
c (this change only affects 0.2 < exC+exO < 0.3 at X > 0.03 [such compositions
c should seldom actually occur], and even there has almost negligible effect).
c------------------------------------------------------------------------------
c*** UPDATED APRIL 6, 2007: from version of MARCH 29, 2007:
c --Minor modifications, for smoother extrapolation in temperature and density
c  (this will also improve the switchover from OPAL to conductive opacities).
c --Fixed a bug that caused incorrect CNO-interpolation at X = 0.03 (actually,
c  for 0.029999 < X < 0.030001), yielding errors (usually, small ones) there.
c --Fixed a bug that could yield an incorrect name for the default [O/Fe] file.
c------------------------------------------------------------------------------
c*** UPDATED MARCH 29, 2007: from version of MARCH 24, 2007:
c --Added updated conductive opacities: from 'Potekhin et al.' (2006).
c------------------------------------------------------------------------------
c*** UPDATED MARCH 24, 2007: from version of FEBRUARY 2, 2007:
c --Simplified quadratic interpolation routines to reduce call overhead.
c --Added option to print out the names of the opacity files that were read in.
c --Fixed bug in Hubbard & Lampe conductive opacity interpolation (that had
c  been introduced by quadratic-interpolation formula of FEBRUARY 2, 2007).
c------------------------------------------------------------------------------
c*** UPDATED FEBRUARY 2, 2007: from version of DECEMBER 16, 2006:
c --Added support for Ferguson et al. 2005 molecular opacities (essentially,
c  updated versions of the Alexander and Ferguson 1994 molecular opacities).
c --Fixed bug in exC- and exO-interpolation at small helium abundances.
c --Modified quadratic-interpolation formulae to reduce roundoff error.
c------------------------------------------------------------------------------
c*** UPDATED DECEMBER 16, 2006: from version of NOVEMBER 23, 2006:
c --Allow bzip2 (de)compression of input files (suffix '.bz2') as well as gzip
c  (suffix '.gz') and compress (suffix '.Z').
c------------------------------------------------------------------------------
c*** UPDATED NOVEMBER 23, 2006: from version of SEPTEMBER 21, 2006:
c --Some updates in the comments below, and a minor bug-fix.
c------------------------------------------------------------------------------
c*** UPDATED SEPTEMBER 21, 2006: from versions of SEPTEMBER 6 and 13, 2006:
c --Fixed the (allowed) extension of OPAL opacities using conductive opacities;
c  such extension now works correctly, when specified by the user.
c------------------------------------------------------------------------------
c*** UPDATED SEPTEMBER 6, 2006: from previous version of OCTOBER 20, 2004:
c *****************************************************************************
c * NOTE that BINARY OPACITY DUMPS of previous versions are INCOMPATIBLE with *
c * this new version, due to changes in the arrays: any such binary dumps     *
c * MUST BE RECOMPUTED using  DUMP_OPAL_OPAC  with this new program version.  *
c *****************************************************************************
c --New, simpler subroutines have been added for reading in the opacities.
c --Alexander & Ferguson (1994) molecular opacity routines and storage added,
c  with relevant subroutines to control its use (by default, it is NOT used).
c --Conductive opacity routines added, allowing use of Hubbard & Lampe (1969),
c  & Itoh et al. (1983), Mitake et al. (1984) [by default these are NOT used].
c --Common block /opalGS98mixes/ revised, to hold the meteoritic Z-mix as well.
c --Minor bug fixed in computation of opacities that require the user-defined
c  (nonCNO-interpolation) file CF_USER.
c --Added new routines:  ASK_OPAL_Z_MIX  to return abundances of components of
c  the metallicity Z, and a few others involving opacity filename control.
c------------------------------------------------------------------------------
c*** UPDATED OCTOBER 20, 2004: from version of JUNE 30, 2004:
c --Common blocks revised, to reduce the file-size of the compiled program (by
c  refraining from initializing any parts of very large common blocks).
c------------------------------------------------------------------------------
c*** UPDATED JUNE 30, 2004: from version of MARCH 9, 2004:
c  --Some redundant variables removed, to avoid compiler warning messages.
c------------------------------------------------------------------------------
c*** UPDATED MARCH 9, 2004: from version of FEBRUARY 1, 2004:
c  --Minor bug-fix in subroutine OPAL_X_CNO_FU, to handle more correctly the
c  previously-ignored possibility that N+Ne may have decreased relative to Z
c  (the bug-fix does its best to prevent exC and exO from becoming negative).
c------------------------------------------------------------------------------
c*** UPDATED FEBRUARY 1, 2004: from version of JANUARY 9, 2004:
c  --Added subroutines  DUMP_OPAL_OPAC  and  READ_OPAL_DUMP  which allow one to
c  store a set of opacities in unformatted binary form for future re-use (gives
c  a large speed advantage when later one wishes to read opacities with the
c  same inputs, at the cost of some disk space for the opacity dumpfile).
c  --Added subroutines  ASK_KHIGHZ_OFE  and  ASK_MAIN_OPAL_FILE.
c  --Moved all initializations of common block variables into a BLOCK DATA, as
c  required by some compilers; fixed a few other minor bugs.
c------------------------------------------------------------------------------
c*** UPDATED JANUARY 9, 2004: from version of AUGUST 2, 2003: minor changes:
c  --Added subroutines  ASK_LAST_OPAC  and  ASK_LAST_XCNOU  (which just return
c  values contained in common blocks /E_OPAL_Z/ and /X_OPAL_Z/, respectively).
c  --Fixed subroutine OPAL_X_CNO_FU so that it no longer yields an error if one
c  calls this subroutine OPAL_X_CNO_FU before calling the subroutine READZEXCO.
c  --Fixed the places where some compilers objected to the use of the string
c  concatenation operator.
c------------------------------------------------------------------------------
c*** UPDATED AUGUST 2, 2003: from version of APRL 27, 2001: Add the option of
c  using an alternate set of OPAL files (e.g., 'GS98hz' rather than 'GN93hz')
c  to get opacities appropriate to an updated solar composition (e.g., Grevesse
c  and Sauval 1998) --- note that the files  Gz???.x??  need not be updated, as
c  their opacities are shifted to agree with those from the file  'GS98hz' .
c  ALSO, add the option of interpolating the opacities as a function of varying
c  relative C, N, O, and Ne abundances (as well as in the "excess" C and O).
c  ALSO, increase the allowed file-plus-directory name length to 255 characters
c  (rather than 80); this affects  common /opdir/  and the alternate OPAL file
c  set, but not  common /opalmixes/  (default OPAL files, 8 characters long).
c  Also, maximum allowed T6,R extrapolation is now just over one grid spacing
c  (instead of just under); this latter change should have negligible effect.
c  Also, an approximation used previously when computing the abundances for
c  mixes that are interpolated in [O/Fe] has been replaced by the exact formula
c  (this change should also have little effect: none at all for [O/Fe]=0.0).
c------------------------------------------------------------------------------
c*** UPDATED APRIL 27, 2001: from version of MARCH 4, 2001: for more accurate
c  X-interpolation at X > 0.1 (with a LARGE improvement in the accuracy as X
c  approaches 1-Z), using the added X-values available in the file  GN93hz  .
c  Also fixed a minor bug in the CO-interpolation (that could have caused small
c  errors in the interpolated opacity, but only in the seldom-encountered
c  situation of near-maximal CO-enrichment combined with a non-zero hydrogen
c  abundance: X > 0.0 with C+O just less than 1-X-Z).
c------------------------------------------------------------------------------
c*** UPDATED MARCH 4, 2001: from version of MAY 28, 1999: add the metallicity Z
c  to the list { X, C, O, T6, R } of variables in which the OPAL opacities can
c  be interpolated (rather than being restricted to only a single metallicity,
c  defined when the opacities were read in).  This is required if gravitational
c  settling of metals takes place.  Also, newly added subroutines allow easier
c  opacity-directory specification, and easier user control of how Z, T, and R
c  edges and extrapolation are handled.  Also, the opacity files  Gz???x??  and
c  GN93hz  are allowed to be in compressed form (they must have suffix  .gz  if
c  they were compressed using 'gzip', or suffix  .Z  if they were compressed
c  using 'compress'); any compressed opacity files will be decompressed, read
c  in, and compressed again.
c------------------------------------------------------------------------------
c  Updated MAY 28, 1999: from version of JUNE 26, 1997: to look for the CO-rich
c  opacity file names in the newer format  Gz???.x??  before trying the old
c  format  Gx??z*  .  Note that some opacity values in  Gz001.x35 Gz004.x70
c  Gz050.x35 Gz100.x70  differ by roundoff amounts (+/- 0.001 in log10[kappa])
c  from corresponding older files  Gx35z001 Gx70z004 Gx35z05 Gx70z10  ; also,
c  Gz050.x35 and  Gz100.x70  each omit a redundant duplicate composition table
c  present in  Gx35z05  and   Gx70z10  .  In all other cases, the newer OPAL
c  files  Gz???.x??  are identical to the corresponding older files  Gx??z* .
c******* ALSO: the name of the common block that returns the opacity values
c  has been changed from  common/e/  to  common/e_opal_z/  in order to avoid
c  compilation errors when compiling using  f2c  (Fortran to C conversion).
c------------------------------------------------------------------------------
c
c******************************************************************************
c
c        TEMPERATURES AND DENSITIES CONTAINED IN OPAL OPACITY TABLES:
c        ************************************************************
c
c  The OPAL opacities are tabulated in terms of logT and logR, where
c    logR = logRHO - 3 * ( logT - 6 )  , i.e.,  R = RHO / T6^3
c  (with T being temperature in Kelvins and RHO being density in g/cm^3)
c  The "density" and temperature ranges contained in the tables are:
c    logR : -8.0 to 1.0   [at logR = -8.0 (0.5) 1.0, i.e., delta_logRHO = 0.5]
c    logT : 3.75 to 8.70  [at logT = 3.75 (0.05) 6.00 (0.10) 8.10 (0.20) 8.70]
c
c            COMPOSITIONS FOR WHICH OPACITY TABLES ARE AVAILABLE:
c            ****************************************************
c
c  Type 2 OPAL Tables - including enhanced C & O (40 files):
c  =========================================================
c  These are 40 files of the form  Gz???.x??  , where the "z???" part may be
c  any of { "z000", "z001", "z004", "z010", "z020", "z030", "z050", "z100" }
c  and the "x??" part may be any of { "x00", "x03", "x10", "x35", "x70" }.
c  These have 8 metallicities Z = { 0.0, .001, .004, .01, .02, .03, .05, .1 }
c  and 5 hydrogen abundances X = { 0.0, 0.03, 0.1, 0.35, 0.7 }; each pair of
c  { X, Z } has up to 60 different compositions with varying amounts of
c  "excess" carbon and oxygen (above that contained in Z), i.e., mixes having
c  exC,exO = { 0.0, .01, .03, .1, .2, .4, .6, 1-X-Z } (such that no mix has
c  X+Z+exC+exO > 1.0).  These files allow fairly good interpolated opacities
c  for X < 0.75 and Z < 0.12, with any amount of excess carbon and oxygen.
c  This may suffice if there is not much diffusion (to yield high X values),
c  but these opacities are NOT AT ALL ACCURATE for X > 0.75 (very high hydrogen
c  abundances); opacities at X = 1-Z may be off by up to an order of magnitude
c  (unless corrected by including the Type 1 tables below).
c
c  The above files are ALWAYS read in, for one or more Z-values (as determined
c  by your call to one of the opacity-reading subroutines).
c
c  Type 1 OPAL Tables - fixed metal distribution (by default, 4 files):
c  ====================================================================
c  file 'GN93hz'   [O/Fe]=0.0: solar composition, Grevesse and Noels (1993)
c  file 'Alrd96a2' [O/Fe]=0.3: alpha enhanced elements, Allard (1996)      
c  file 'C95hz'    [O/Fe]=0.4: alpha enhanced elements, Chaboyer (1995)    
c  file 'W95hz'    [O/Fe]=0.5: alpha enhanced elements, Weiss (1995)       
c  Each of these 4 files contains 126 compositions: opacities at 13 Z-values
c  Z = {0.0,0.0001,0.0003,0.001,0.002,0.004,0.01,0.02,0.03,0.04,0.06,0.08,0.1}
c  and at 10 X-values X = {0.0,0.1,0.2,0.35,0.5,0.7,0.8,0.9,0.95,1-Z}; they do
c  NOT have enhanced-CO ("excess-C,O") compositions.
c
c  One or two of these Type 1 files will typically be read in (as determined by
c  your call to one of the opacity-reading subroutines).  For non-CO-rich cases
c  this allows slightly improved Z-interpolation (for Z < 0.12) and slightly
c  improved X-interpolation (for 0.03 < X < 0.75); for high hydrogen abundances
c  (X > 0.75), such as may result from diffusion (e.g., helium settling), the
c  accuracy is GREATLY IMPROVED.
c
c  NOTE THAT additional Type 1 tables can be computed at the OPAL website, or
c  may be available elsewhere.  By default, this program alows for counterparts
c  of the above 4 files with a different composition (e.g., for the Grevesse &
c  Sauval 1998 mix: 'GS98hz', 'GS98hz_OFe.3_Alrd96a2', 'GS98hz_OFe.4_C95', and
c  'GS98hz_OFe.5_W95', or the more recent Asplund, Grevesse, & Sauval 2004 mix:
c  'AGS04hz', etc.).  This program also allows for the existence of files where
c  C, N, O, and Ne abundances are interconverted (as by nuclear burning: e.g.,
c  'GN93hz.CtoN', 'GN93hz.COtoN', 'GN93hz.CNOtoNe'); such files can be used
c  to enable the program to return accurate opacity values as a function of
c  varying relative C, N, O, and Ne abundances.  Some other user-specified
c  element (or set of elements) can also be interpolated (e.g., 'GN93hz.user').
c
c  The program can also be set to use  'AGS04hz'  etc., instead of the above.
c
c
c  Additional (OPTIONAL) non-OPAL tables: conductive and molecular opacities:
c  ************************************** ===================================
c
c  -- They are available for the sake of convenience (to allow extension of the
c       OPAL opacities to lower T and higher R), and some testing has been done
c       to check that the switchover between tables works reasonably, but the
c       USER MUST CHOOSE whether to read in (and use) these extensions or not.
c
c
c  'Potekhin et al.' (2006) CONDUCTIVE OPACITIES: opacity file 'condall06.d'
c  =========================================================================
c  -- Conductive opacities available:  http://www.ioffe.rssi.ru/astro/conduct/
c******************************************************************************
c*****  NOTE: as of March 9, 2007: the revised/updated file  condall06.d  *****
c*****  containing conductive opacities is available on the website.      *****
c*****  This should be an improvement over the Hubbard & Lampe (1969)     *****
c*****  plus Itoh (1984) conductive opacities described further below.    *****
c******************************************************************************
c  These 'condall06.d' electron conductivities are available in the ranges:
c    -6 < logRHO < 9.75    in density RHO, with spacing  delta logRHO = 0.25
c    3 < logT < 9          in temperature T, with spacing  delta logT = 1/3
c    Zion = {1,2,3,4,6,8,12,16,20,26,30,36,42,48,60}    mean nuclear charge
c
c-----FROM THE ABOVE WEBPAGE:  "The plasma is assumed fully ionized (electron
c  collisions with neutrals are neglected, the ions are assumed pointlike).
c  This model may be still useful for evaluation of conductivities of partially
c  ionized plasmas, if one uses a mean-ion model.  Then the ion charge Zion
c  should be replaced by an effective (or average) ion charge Zeff.  For
c  nondegenerate plasmas, the results are based on a continuation from the
c  degenerate domain (using Fermi-Dirac averaging) and can be considered as
c  order-of-magnitude estimates.  For degenerate plasmas, on the contrary, the
c  results come from the exact theory and should be much more accurate."
c    "Non-magnetic conductivities have been updated 18 July 2006.  The updated
c  codes and table have been put at this site 9 September 2007.  There are two
c  modifications.  1. The electron-electron (ee) scattering contribution is
c  now included in such a way that both the cases of strongly degenerate and
c  nondegenerate plasmas are recovered accurately.  Now the high-T limit of our
c  data matches the numerical tables of Hubbard & Lampe, 1968, ApJS 18, 297
c  (which remain the most accurate calculations of conductive opacities for
c  astrophysical use in nonmagnetic, nondegenerate, weakly coupled plasma).
c  2. The ee contribution is updated according to the results by Shternin and
c  Yakovlev (2006)."
c
c-----References for the above (non-magnetic) electron thermal conductivities:
c    A. Y. Potekhin, D. A. Baiko, P. Haensel, D. G. Yakovlev (1999), "Transport
c  properties of degenerate electrons in neutron star envelopes and white
c  dwarf cores", Astron. Astrophys. 346, 345
c    O. Y. Gnedin, D. G. Yakovlev, A. Y. Potekhin (2001), "Thermal relaxation
c  of young neutron stars", Mon. Not. R. Astron. Soc. 324, 725
c    P. S. Shternin, D. G. Yakovlev (2006), "Electron thermal conductivity
c  owing to collisions between degenerate electrons", Phys. Rev. D 74, 043004
c    S. Cassisi, A. Y. Potekhin, A. Pietrinferni, M. Catelan, M. Salaris (2007)
c  "Updated electron-conduction opacities: the impact on low-mass stellar
c  models", Astrophys. J., in press [astro-ph/0703011]
c
c-----NOTE: the last reference above suggests that the rms ionic charge is the
c  appropriate one for use in plasmas not so dense as to be crystalline, i.e.,
c    Zion = (<z^2>)^0.5 = sqrt( SUM_i{ z_i * z_i * n_i } / SUM_i{ n_i } )
c         = sqrt( SUM_i{ z_i * z_i * X_i / A_i } / SUM_i{ X_i / A_i } )
c  where z_i is the ionic charge of element i and n_i is its number density;
c  n_i is proportional to X_i / A_i, the mass fraction over the atomic mass.
c    [Correctly summing the contributions of different ions in a multicomponent
c  plasma would be "much more complicated", according to the references.]
c    Also: the log of the electron thermal conductivity  logCHI  (stored in the
c  file condall06.d) converts to the log of the conductive opacity  logKAPPA_c
c  via:
c       logKAPPA_c = log( 16 * sigma / 3 ) + 3 * logT - logRHO - logCHI
c  where
c       sigma = the Stefan-Boltzmann constant.
c
c  - By default, if conductive opacities are read in, then the (OPAL) opacity-
c  calculating subroutines will actually return the overall effective opacity
c    Kappa = 1 / ( 1 / Kappa_radiative + 1 / Kappa_conductive )  .
c  This will be allowed to extend the opacities to the highest densities for
c  which valid conductive opacities are available (significantly higher than
c  the upper density limit of the OPAL opacity table, at most temperatures).
c
c
c  The above are preferable to the older available conductive opacities:
c
c  W.B. Hubbard & M. Lampe (1969) ApJS, 163, 297: H&L opacity file 'Condopac'
c  ==========================================================================
c  -- In a form usable by these opacity subroutines, this file is available
c       only from   http://www.cita.utoronto.ca/~boothroy/kappa.html
c       (the same website as for this file containing the opacity subroutines).
c  This file includes 'H&L' conductive opacities for H, He, and C, for somewhat
c  irregular temperature ranges in the density range -6 < logRHO < 6.  When
c  this file is read in, approximate tables for O and Ne are also stored (by
c  adding a constant to the table for C).
c
c  'Itoh' (1984) conductive opacities (to supplement the above input file)
c  =======================================================================
c  - By default, the 'H&L' tables are superseded by the later 'Itoh' conductive
c  opacities at high density (where the latter are valid), using formulae from
c  N. Itoh, S. Mitake, H. Iyetomi, & S. Ichimaru (1983), ApJ 273, 774, plus
c  S. Mitake, S. Ichimaru, & N. Itoh (1984), ApJ 277, 375.  [The formulae are
c  used to get the combined effects of conductive opacities for H, He, C, O,
c  and Ne, where Ne represents all elements heavier than oxygen.]
c
c  - "Reasonable" interpolated (and extrapolated) conductive opacity values are
c  computed in regions where neither of the above are valid.
c
c
c  J.W. Ferguson et al. (2005) ApJ, 623, 585: (updated) MOLECULAR OPACITY files
c  ============================================================================
c  -- Opacity files available from  http://webs.wichita.edu/physics/opacity/
c******************************************************************************
c*****  NOTE that these 2005 molecular opacities should supersede and     *****
c*****  replace those of Alexander & Ferguson (1994) below; the authors   *****
c*****  state that the accuracy should be significantly better.           *****
c******************************************************************************
c  The Ferguson et al. (2005) molecular opacity table ranges are:
c    2.7 < logT < 4.5  in temperature T  [one table may be missing logT < 2.8]
c                         at logT = 4.5 (-0.05) 3.5 (-0.01) 2.9 (-0.05) 2.7
c    -8.0 < logR < 1.0  in R = RHO / T6^3  [this is same range as OPAL tables]
c                         at logR = -8.0 (0.5) 1.0
c    Z = { 0.0 0.00001 0.00003 0.0001 0.0003 0.001 0.002 0.004 0.01 0.02 0.03
c            0.04 0.05 0.06 0.08 0.1 }
c    X = { 0.0 0.1 0.2 0.35 0.5 0.7 0.8 0.9 0.95 1-Z }
c  Each of the 155 (X,Z) cases has its own ASCII file of opacity values, with
c  the file name reflecting the values of X and Z (as per examples below).
c  Several different mixes are available, each with its set of 155 (X,Z) cases
c  (contained in a gzip-compressed tar archive on the above web page); for most
c  of these, compositions are also specified:
c  --- GN93 mix (Grevesse & Noels 1993): tar archive  f05.g93.tar.gz  contains
c   g0.0.tron g0.00001.tron ... g99999.00001.tron g10.0.tron
c  --- GS98 mix (Grevesse & Sauval 1998):  f05.gs98.tar.gz  contains
c   g98.0.0.tron g98.0.00001.tron ... g98.99999.00001.tron g98.10.0.tron
c  --- L03 mix (Lodders 2003):  f05.l03.tar.gz  contains
c   l03.0.0.tron l03.0.00001.tron ... l03.99999.00001.tron l03.10.0.tron
c  --- AGS04 mix (Asplund, Grevesse & Sauval 2004):  f05.ags04.tar.gz  contains
c   ags04.0.0.tron ags04.0.00001.tron ... ags04.99999.00001.tron ags04.one.tron
c  Compositions are listed on the website for these mixes.  There are also two
c  mixes for which opacities are available but the composition is not listed:
c  --- S92 mix (Seaton 1992) -- composition unspecified, but mix is presumably
c  very similar to GN93 (opacities are very similar):  f05.s92.tar.gz  contains
c   s92.0.0.tron s92.0.00001.tron ... s92.99999.00001.tron s92.one.tron
c  --- S92AE mix (alpha-element-enhanced version of S92) -- composition not
c  specified, except for [alpha/Fe] = [O/Fe] = 0.3:  f05.s92ae.tar.gz  contains
c   s92ae.0.0.tron s92ae.0.00001.tron ... s92ae.99999.00001.tron s92ae.one.tron
c  --- alpha-enhanced mixes for Grevesse & Sauval 1998 (the compositions for
c  these are listed on the website):
c    --- GS98-.2 with [alpha/Fe] = [O/Fe] = -0.2: f05.gs98-.2.tar.gz contains
c         gs98-.2.0.0.tron ... gs98-.2.99999.00001.tron gs98-.2.one.tron
c    --- GS98+.2 with [alpha/Fe] = [O/Fe] = 0.2: f05.gs98+.2.tar.gz contains
c         gs98+.2.0.0.tron ... gs98+.2.99999.00001.tron gs98+.2.one.tron
c    --- GS98+.4 with [alpha/Fe] = [O/Fe] = 0.4: f05.gs98+.4.tar.gz contains
c         gs98+.4.0.0.tron ... gs98+.4.99999.00001.tron gs98+.4.one.tron
c    --- GS98+.6 with [alpha/Fe] = [O/Fe] = 0.6: f05.gs98+.6.tar.gz contains
c         gs98+.6.0.0.tron ... gs98+.6.99999.00001.tron gs98+.6.one.tron
c    --- GS98+.8 with [alpha/Fe] = [O/Fe] = 0.8: f05.gs98+.8.tar.gz contains
c         gs98+.8.0.0.tron ... gs98+.8.99999.00001.tron gs98+.8.one.tron
c
c***Any excess C or O is simply added to Z, yielding LESS ACCURATE OPACITIES.
c
c  - Opacities are considered to be O.K. for Ztotal < 0.10, and Ztotal > 0.12
c  is considered to be "unavailable" (where Ztotal = Z + exC + exO).
c
c  - By default, the switchover from OPAL to Ferguson et al. 2005 opacities
c  will occur smoothly as logT is reduced from 4.4 to 4.2 (this is the
c  temperature range in the overlap region where the two opacity tables seem
c  to be the closest to being equal).
c
c
c  D.R. Alexander & J.W. Ferguson (1994) ApJ, 437, 879: opacity file 'Alexopac'
c  ============================================================================
c  -- In a form usable by these opacity subroutines, this file is available
c       only from   http://www.cita.utoronto.ca/~boothroy/kappa.html
c       (the same website as for this file containing the opacity subroutines).
c******************************************************************************
c*****  NOTE that these 1994 molecular opacities are SUPERSEDED by the    *****
c*****  2005 opacities from   http://webs.wichita.edu/physics/opacity/    *****
c*****  (see Ferguson et al. 2005, ApJ, 623, 585), as DESCRIBED ABOVE.    *****
c******************************************************************************
c  This file includes molecular opacities and dust opacity; table ranges are:
c    3.0 < logT < 4.1  in temperature T,
c    -12.0 < logRHO < -6.0  in density RHO (not R, unlike OPAL), for
c    Z = { 0.0001, 0.0003, 0.001, 0.002, 0.004, 0.01, 0.02, 0.03, 1.0 }  and
c    X = { 0.0001, 0.03, 0.10, 0.35, 0.70, 0.80 }  .
c  [note that the Z = 1.0 table is of course only available for X = 0.0].
c  Extensions of this table:
c  - The X = 0.0001 tables are treated as having X = 0.0 (the difference is
c  negligible for the above metallicity range 0.0001 < Z < 0.03).
c  - Unlike the OPAL 'GN93hz' opacities, these must be extrapolated for X > 0.8
c  but this yields errors no larger than the difference between Alexander and
c  OPAL opacities even up to X = 1 - Z.
c  - To match the available OPAL tables, tables at Z = 0.05 and Z = 0.10 were
c  extrapolated from the Z = 0.02 and 0.03 cases, taking the average of the
c  result of extrapolating Kappa in Z and of logKappa in logZ (this yielded the
c  best results in the temperature region of overlap between Alxander and OPAL
c  opacities).
c  - A set of { Z = 0.0, X = 0.7 } opacities have been obtained using Fig. 1 of
c  Alexander & Ferguson 1994, and the OPAL opacities at logT = 3.75 or higher.
c  - A rough approximation of opacities for { Z = 0.0, X = 0.0 } was obtained
c  by using the OPAL opacities at high-T, and extrapolating logKappa downwards
c  in logT by fitting a least-squares quadratic.
c  - For other X-values at Z=0.0 these two opacity sets were interpolated in X.
c
c***This extends the tables of low-temparature opacities from 0.0001 < Z < 0.03
c  to the full available metalliticy range 0.0 < Z < 0.1 of the OPAL tables;
c  but THE ACCURACY OF THE EXTENSIONS MAY BE POOR (especially for Z < 0.0001);
c  it is better to use the Ferguson et al. (2005) molecular opacities instead.
c
c***Also, any excess carbon or oxygen is simply added to Z: for significant
c  "excess-C,O" (exC,exO comparable to Z) this yields LESS ACCURATE OPACITIES,
c  and for large "excess-C,O" (0.1 < Z + exC + exO < 1.0) one must interpolate
c  between the Z = 0.1 and Z = 1.0 mixes, yielding VERY INACCURATE OPACITES.
c
c  - By default, if 'Alexopac' is read in, then the switchover from OPAL to
c  Alexander opacities will occur smoothly as logT is reduced from 3.97 to 3.87
c  (this is the temperature range in the overlap region where the two opacity
c  tables seem to be the closest to being equal).
c
c  - By default, Alexander opacities are considered to be O.K. for Z < 0.10 at
c  all X, and for all Z at X = 0.0; they are considered to be "unavailable" in
c  the region where Z > 0.15 at X > 0.03 (this constraint be tightened by the
c  user at the time when the opacities are read in).
c
c
c------------------------------------------------------------------------------
c
c
c                 ==========================================
c                 List of subroutines contained in this file
c                 ==========================================
c
c  This file contains the following subroutines; the nine subroutines marked
c  with  **  are those the user is most likely to wish to use (and are the
c  first subroutines described below), while those marked with  *  can be
c  called by the user (and are described in the comments further below):
c
c    BLOCK DATA OPAL_OPAC_DATA
c    SUBROUTINE OPALINIT( KHIGHZ, OFEBRACK, Z, KZ, KMET )
c    SUBROUTINE GET_ZAVAIL
c    SUBROUTINE GET_TRVALS
c ** SUBROUTINE OPAC( Z, XH, EXC, EXO, T6, R )
c ** SUBROUTINE OPAL( Z, XH, EXC, EXO, SLT, SLR )
c ** SUBROUTINE OPAL_X_CNO_FU( XH, SLT, SLR, XMET, NMET, FU )
c  * SUBROUTINE OPAL_F_CNOU( Z, XH, EXC, EXO, SLT, SLR, FCN, FCON, FCNONE, FU )
c    SUBROUTINE OPAL_F_XCON_CNOU( Z, XH, EXC, EXO, Y, XCN, XON, XNEHEAVY,
c                   FMUAINV, FMUEINV, ZSQBAR, SLT, SLR, FCN, FCON, FCNONE, FU )
c    SUBROUTINE Z_FCNO( XH,XMET,NMET,FU, Z,EXC,EXO, Y,XCN,XON,XNEHEAVY,
c                       FMUAINV,FMUEINV,ZSQBAR, FCN,FCON,FCNONE,FUSE )
c  * SUBROUTINE KAPFERG(SLT,SLR,XH,Z,EXC,EXO,FLKA,DLKATR,DLKARO,DLKAT,FKAEDGE)
c  * SUBROUTINE CACHEFERG( KSTO, XH, XZCO )
c  * SUBROUTINE KAP_MOL(SLT,SLR,XH,Z,EXC,EXO,FLKA,DLKATR,DLKARO,DLKAT,FKAEDGE)
c  * SUBROUTINE KAPALEX( FLT, FLRO, X, XZCO, FLKA, DLKAT, DLKARO, FKAEDGE )
c  * SUBROUTINE ASK_LAST_ALEX_EDGE( FKAEDGE, FTRA, FTRA_LO, FTRA_HI, FZKAEDGE )
c  * SUBROUTINE KAPCOND( FLRO, FLT, X, Y, XCN, XON, XNEHEAVY, FMUAINV, FMUEINV,
c                        ZSQBAR, IDER, FLKC, FLKCT, FLKCRO, FKCEDGE, FKCOK )
c  * SUBROUTINE KAP_COND_POT( FLRO, FLT, ZION, IDER,
c                             FLKC, FLKCT, FLKCRO, FKCEDGE, FKCOK )
c  * SUBROUTINE OPAL_K_ONLY( Z, XH, EXC, EXO, SLT, SLR, FCN, FCON, FCNONE, FU )
c ** SUBROUTINE ASK_LAST_OPAC( OP, DOPT, DOPR, DOPTD, FEDGE, FTREDGE, FZEDGE )
c  * SUBROUTINE ASK_LAST_XCNOU( Z, X, XC, XO, SLT, SLR, FCN, FCON, FCNONE, FU )
c  * SUBROUTINE ASK_OPAL_Z_MIX( IMIX, XIZ, N_X, FNINZ, N_N )
c  * SUBROUTINE ASK_OPAL_MIX_WT( ATWT, NWT, ATWTHHE, NHHE, ATZ, NZ )
c ** SUBROUTINE SET_OPAL_DIR( CDIRIN )
c ** SUBROUTINE SET_MOL_DIR( CDIR_MOL )
c ** SUBROUTINE SET_COND_DIR( CDIR_COND )
c ** SUBROUTINE SET_OPAL_LIST_LEVEL( LIST_LEVEL )
c  * SUBROUTINE SET_OPAL_LIST_UNIT( LIST_IU )
c ** SUBROUTINE READ_BASIC_OPAL_OPAC( IU, Z, CF_HZ, OFEBRACK, CF_OFE )
c ** SUBROUTINE READ_EXTENDED_OPAC( IU, Z, CF_HZ, OFEBRACK, CF_OFE,
c                                   I_MOL, I_COND, I_CNO, CF_USER )
c  * SUBROUTINE SET_OFE_FILE( CFILEOFE )
c  * SUBROUTINE SET_ALTMIX_OFE_FILE( CFILEOFE )
c  * SUBROUTINE SET_METEOR_MIX_FILE( CFILEMET )
c  * SUBROUTINE SET_ALTMIX_MAIN_FILE( CFILE_HZ )
c  * SUBROUTINE SET_CNO_FILES( CF_HZ, CF_C, CF_O, CF_N, CF_U )
c  * SUBROUTINE SET_CNO_EXT( IE, CE_HZ, CE_C, CE_O, CE_N, CE_U )
c  * SUBROUTINE SET_COND_FILE( CFILECOND, I_FULL_PATH )
c  * SUBROUTINE SET_COND_USE( KCOND, KREPLACE_ITOH )
c  * SUBROUTINE SET_COND_INFLAGS( KCOND_FIX, KCOND_GAP, KCOND_HAVE )
c  * SUBROUTINE ASK_COND_USE( KCOND, KCOND_AVAIL, KREPLACE_ITOH )
c  * SUBROUTINE ASK_COND_INFLAGS( KC_FIX, KC_GAP, KC_FIX_N, KC_GAP_N )
c  * SUBROUTINE SET_FERG_USER( CBEG_FERG )
c  * SUBROUTINE ASK_FERG_USER( CBEG_FERG )
c  * SUBROUTINE SET_FERG_ACC( IACC )
c  * SUBROUTINE ASK_FERG_ACC( IACC )
c  * SUBROUTINE SET_ALEX_FILE( CFILEALEX, I_FULL_PATH )
c  * SUBROUTINE SET_ALEX_USE( KALEX )
c  * SUBROUTINE SET_ALEX_DO_RHOSW( IRHOSW )
c  * SUBROUTINE ASK_ALEX_USE( KALEX, KALEX_AVAIL, ITYPE )
c  * SUBROUTINE ASK_KHIGHZ_OFE( KHIGHZ_USED, OFEBRACK_USED )
c  * SUBROUTINE ASK_OPAL_FILE_USED( ITYPE, CF_USED )
c  * SUBROUTINE SET_XHI( KXHI )
c  * SUBROUTINE ASK_XHI( KXHI, KAVAIL )
c  * SUBROUTINE SET_CNO_INTERP( KCNO, KUSER )
c  * SUBROUTINE ASK_CNO_INTERP( KCNO, KUSER, KCNO_AVAIL, KUSER_AVAIL )
c  * SUBROUTINE SET_ERR_CHECK( LEVEL )
c  * SUBROUTINE ASK_ERR_CHECK( LEVEL )
c  * SUBROUTINE SET_LOGT6_LIMITS( VLO, DVLO, VHI, DVHI )
c  * SUBROUTINE SET_LOGR_LIMITS( VLO, DVLO, VHI, DVHI )
c  * SUBROUTINE RESET_Z_LIMITS( VLO, DVLO, VHI, DVHI )
c  * SUBROUTINE ASK_LOGT6_LIMITS( VLO, DVLO, VHI, DVHI )
c  * SUBROUTINE ASK_LOGR_LIMITS( VLO, DVLO, VHI, DVHI )
c  * SUBROUTINE ASK_Z_LIMITS( NZMAX, ZMIN, ZMAX )
c  * SUBROUTINE ASK_Z_USE( NZUSE, ZLO, ZMID, ZHI, ZLOEX, ZHIEX )
c  * SUBROUTINE ASK_Z_ARRAY( KZSTART, KARRAYSTART, ZARRAY, NARRAY )
c  * SUBROUTINE SET_SMOOTH( INITSMOOTH, LOWCOSMOOTH, INTERPCOSMOOTH )
c  * SUBROUTINE ASK_SMOOTH( INITSMOOTH, LOWCOSMOOTH, INTERPCOSMOOTH )
c  * SUBROUTINE SET_LOGT_SW_FERG( FLTSW_LO, FLTSW_HI )
c  * SUBROUTINE ASK_LOGT_SW_FERG( FLTSW_LO, FLTSW_HI )
c  * SUBROUTINE SET_LOGT_SW_ALEX( FLTSW_LO, FLTSW_HI )
c  * SUBROUTINE SET_LOGRHO_SW_ALEX( FLRHOSW_LO, FLRHOSW_HI )
c  * SUBROUTINE SET_LOGT_RHOSW_ALEX( FLTSW_R_LO, FLTSW_R_HI )
c  * SUBROUTINE ASK_LOGT_SW_ALEX( FLTSW_LO, FLTSW_HI )
c  * SUBROUTINE ASK_LOGRHO_SW_ALEX( FLRHOSW_LO, FLRHOSW_HI )
c  * SUBROUTINE ASK_LOGT_RHOSW_ALEX( FLTSW_R_LO, FLTSW_R_HI )
c  * SUBROUTINE READCO( Z, KALLRD, KHIGHZ, IULOW )
c  * SUBROUTINE READEXCO( Z, KALLRD, KHIGHZ, IULOW, OFEBRACK )
c  * SUBROUTINE READZEXCO( NZIN, ZLO, Z, ZHI, KHIGHZ, IULOW, OFEBRACK )
c  * SUBROUTINE READ_BEST_MOL( IU, I_MOL, CF_HZ, OFEBRACK )
c  * SUBROUTINE READFERG( IU )
c  * SUBROUTINE ADDFILE_FERG( IU, F_STO, F_READ, CFILEFERG, I_FULL_PATH )
c  * SUBROUTINE READ_ADD_FERG( IU, F_STO, F_READ, KTYPE_FERG )
c    SUBROUTINE FIND_FERG( KTYPE_FERG, LEN_BEG, CFILE_USE )
c    SUBROUTINE INIT_FERG_INDICES
c  * SUBROUTINE READALEX( IU )
c  * SUBROUTINE READ_COND_POT( IU )
c  * SUBROUTINE READCOND( IU )
c    SUBROUTINE FIND_RJUMP_HL_COND
c ** SUBROUTINE DUMP_OPAL_OPAC( IU, CF_D )
c ** SUBROUTINE READ_OPAL_DUMP( IU, CF_D )
c    SUBROUTINE READ_KZ( KZ, Z, KALLRD, KHIGHZ, IULOW, OFEBRACK )
c    SUBROUTINE REVISE_HITR_FOR_INITSMOOTH
c    SUBROUTINE COINTSMO( XXC, XXO, KZ )
c    SUBROUTINE COINTERP( XXC, XXO, KZ )
c    SUBROUTINE T6RINTERP( SLR, SLT )
c    SUBROUTINE SNGL_CINTERP3(ZM,Z0,Z1,ZP,Z,N0,MXNV,VM,V0,V1,VP,VF,DF,D2,XH)
c    SUBROUTINE QZLOG4INT( ZLOGD )
c    FUNCTION QUADSL( IC, I, X, Y1, Y2, Y3, X1, X2, X3 )
c    FUNCTION QDERSL( IC, I, X, Y1, Y2, Y3, X1, X2, X3 )
c    FUNCTION QCHKSL( IC, I, X, Y1, Y2, Y3, X1, X2, X3 )
c    FUNCTION QUAD( IC, I, X, Y1, Y2, Y3, X1, X2, X3 )
c    FUNCTION QDER( IC, I, X, Y1, Y2, Y3, X1, X2, X3 )
c    FUNCTION QCHK( IC, I, X, Y1, Y2, Y3, X1, X2, X3 )
c    FUNCTION QZINTER( IC, I, Z, NMOREZ, F1, F2, F3, F4, Z1, Z2, Z3, Z4, ZDEL )
c    FUNCTION MIXFIND( IU, IOFE, IGETZXI, IREW, ITAB, LINE, Z, X, C, O )
c    SUBROUTINE CHK_DIR_NAME( CDIRIN, COPDIR, KOPE )
c    SUBROUTINE CHK_OFE_ALT_FILE( K_OFE )
c    SUBROUTINE INDEX_CO_DELTAS( ISET, KXHZ, JX, JC, JO )
c    SUBROUTINE FINISH_CNO
c    SUBROUTINE SPLINE( X, Y, N, Y2 )
c    SUBROUTINE SPLINT( XA, YA, N, Y2A, X, Y, YP )
c    SUBROUTINE FITY
c    SUBROUTINE FITX
c    SUBROUTINE GETD( F, N, D, FP1, FPN )
c    SUBROUTINE INTERP( FLT, FLRHO, G, DGDT, DGDRHO, IERR )
c    SUBROUTINE SMOOTH
c    SUBROUTINE OPALTAB
c    SUBROUTINE OPEN_CHK_ZIP( IU, FNAME, IGZIP, CMSG )
c    SUBROUTINE CLOSE_CHK_ZIP( IU, FNAME, IGZIP )
c    SUBROUTINE QUADSLSTO( I, X, X1, X2, X3 )
c    FUNCTION QUADSLGET( I, Y1, Y2, Y3 )
c    SUBROUTINE QDERSLSTO( I, X, X1, X2, X3 )
c    SUBROUTINE QDERSLGET( I, Y1, Y2, Y3, Y, DYDX )
c    SUBROUTINE QCHKSLSTO( I, X, X1, X2, X3 )
c    FUNCTION QCHKSLGET( I, Y1, Y2, Y3 )
c    SUBROUTINE QCHKSTO( I, X, X1, X2, X3 )
c    FUNCTION QCHKGET( I, Y1, Y2, Y3 )
c    SUBROUTINE QDERNSTO( I, NMORE, X, X1, X2, X3, X4 )
c    SUBROUTINE QDERNGET( I, NMORE, Y1, Y2, Y3, Y4, Y, DYDX )
c    SUBROUTINE QUADNSTO( I, NMORE, X, X1, X2, X3, X4 )
c    FUNCTION QUADNGET( I, NMORE, Y1, Y2, Y3, Y4 )
c    SUBROUTINE QDER4STO( I, X, X1, X2, X3, X3 )
c    SUBROUTINE QDER4GET( I, Y1, Y2, Y3, Y4, Y, DYDX )
c    SUBROUTINE QUAD4STO( I, X, X1, X2, X3, X3 )
c    FUNCTION QUAD4GET( I, Y1, Y2, Y3, Y4 )
c    SUBROUTINE QDERSTO( I, X, X1, X2, X3 )
c    SUBROUTINE QDERGET( I, Y1, Y2, Y3, Y, DYDX )
c    SUBROUTINE QUADSTO( I, X, X1, X2, X3 )
c    FUNCTION QUADGET( I, Y1, Y2, Y3 )
c    FUNCTION NUM_BLANKS_CONTAINED( FNAME )
c    FUNCTION NON_BLANK_BEGIN( FNAME )
c    SUBROUTINE OPOLDR( IU, FNAME )
c    SUBROUTINE OPOLUF( IU, FNAME )
c    SUBROUTINE OPNEUF( IU, FNAME )
c    SUBROUTINE INQFIL( FNAME, LXST )
c    SUBROUTINE LINUX_GET_HOME_DIR( FNAME, FNALT, IALT )
c    FUNCTION LNBLNK( FNAME )
c
c  The last 6 of the above subroutines contain file-handling routines; if one
c  is using VMS rather than some flavor of Unix or Linux, then one may have to
c  comment out some statements in these subroutines and uncomment others, as
c  well as in the "data cb" statement at the end of BLOCK DATA OPAL_OPAC_DATA.
c  (The last 2 routines should be needed only if you are using fort77 under
c  Linux, but should still work correctly on any flavor of Unix/Linux system.)
c
c  Note that the above routines have been tested on several Linux systems (and
c  Unix, for some earlier versions), but have NOT been tested on a VMS system.
c
c  **********************************************************
c  NOTE THAT ALL REAL VARIABLES ARE SINGLE PRECISION (real*4)
c  **********************************************************
c
c  **********************************************************
c  NOTE THAT NO FILENAME MAY EXCEED 255 CHARACTERS IN LENGTH.
c  **********************************************************
c
c
c------------------------------------------------------------------------------
c
c
c         ==========================================================
c         The subroutines that interpolate among the OPAL opacities:
c         ==========================================================
c
c
c-----NOTE that the following four opacity-calculating subroutines CAN extend
c  the OPAL opacities to lower temperatures (by using molecular opacities) or
c  to higher densities (using conductive opacities); whether they do either
c  (or both) of these extensions DEPENDS ON HOW YOU READ IN THE OPACITIES via
c  the subroutines described further below.
c
c
c*** OPAC( z, xh, exC, exO, T6, R )     The purpose of the subroutines OPAC or
c    ------------------------------     OPAL is to perform up to 6-variable
c*** OPAL( z, xh, exC, exO, slt, slr )  interpolation on log10(kappa), to yield
c    ---------------------------------  the opacity (and also its temperature
c  and density derivatives) at the given composition, temperature, and density
c  values (the details of how this interpolation is performed are discussed
c  further below).  The user can control how the opacities are initially read
c  in via subroutines discussed further below; otherwise, the first time OPAC
c  or OPAL is called, opacities will be read in for an estimated "optimum"
c  range of Z-values (that encompass the input value z).  These subroutines
c  actually call OPAL_F_CNOU( z, xh, exC, exO, slt, slr, 0.0, 0.0, 0.0, 0.0 )
c  (see description below) to perform the opacity interpolation.
c
c  The SINGLE-PRECISION REAL interpolation variables are:
c
c       z      The metallicity, Z (excluding any "excess" C and O)
c       xh     The hydrogen mass fraction, X
c       exC    The enhanced ("excess") carbon mass fraction, exC.  
c                The total carbon mass fraction, Xc, is the sum of exC and
c                the initial amount included in the metal mass fraction Z
c       exO    The enhanced ("excess") oxygen mass fraction, exO.
c OPAC:
c       T6     The temperature in millions of degrees Kelvin, T6
c       R      = { rho(gm/cc) / T6**3 }, the temperature-shifted density value
c OPAL:
c       slt    log10(T6) = log10(T) - 6
c       slr    log10(R) = log10(rho) - 3 * slt = log10(rho) - 3 * [log10(T)-6]
c
c  (by definition, the helium mass fraction is Y = 1.0 - z - xh - exC - exO).
c  Note that, while z and xh must be non-negative, small NEGATIVE values for
c  exC and/or exO are allowed, provided that the sums { z + exC , z + exO ,
c  z + exC + exO } are non-negative; this leads to (linear) extrapolation
c  in log(z+exC+0.001) and/or log(z+exO+0.001), unlike the earlier version of
c  MAY 28, 1999 (where negative exC or exO values were treated as being zero).
c
c
c  Your routine that calls to OPAC or OPAL should either include the statement:
c
c      common/e_opal_z/ opact,dopact,dopacr,dopactd,fedge,ftredge,fzedge
c
c  OR ELSE, after calling the opacity-calculation routine (e.g., OPAC or OPAL):
c
c         call ASK_LAST_OPAC(OPACT,DOPACT,DOPACR,DOPACTD,FEDGE,FTREDGE,FZEDGE)
c              ---------------------------------------------------------------
c
c  (this subroutine ASK_LAST_OPAC just returns the values from the common block
c  /e_opal_z/ in its user-supplied arguments).
c
c  These SINGLE-PRECISION REAL variables have the following meanings:
c     
c      OPACT       returns the Log of the Rosseland mean opacity: Log10(kappa)
c      DOPACT      returns dLog(kappa)/dLog(T6) at constant R (NOT rho!)
c      DOPACR      returns dLog(kappa)/dLog(R) at constant T6, which is
c                           = dLog(kappa)/dLog(rho) at constant temperature
c      DOPACTD     returns dLog(kappa)/dLog(T6) at constant density, which is
c                           = dLog(kappa)/dLog(T) at constant density
c                           = DOPACT - 3.0 * DOPACR
c      FEDGE       returns the degree-of-extrapolation product FTREDGE * FZEDGE
c                        or, in some cases, A SMALLER VALUE (even zero):
c                     - If you have read in conductive opacities, then FEDGE is
c                        reduced in switchover regions (radiative to conductive
c                        or one conductive table to another) where one or both
c                        of the opacities requires some extrapolation (FTREDGE,
c                        described below, is NOT reduced, to indicate that the
c                        opacities should still be quite accurate there).
c                     - If the 'GN93hz' opacities are NOT available, then FEDGE
c                        reduces to zero as X increases from 0.76 to 0.8 (but
c                        the opacity is still calculated out to X = 1 - Z); you
c                        should ALWAYS SUPPLY the file 'GN93hz', since errors
c                        can be quite large in some cases if you do not (up to
c                        an order of magnitude for Z < 0.001 at X = 1 - Z).
c      FTREDGE     returns 1.0 for T6,R inside table boundaries, reduces to 0.0
c                        as T6,R moves more than one grid spacing outside table
c                        (except, in general, in switchover regions).
c      FZEDGE      returns 1.0 for Z inside the available range [zlow,zhigh],
c                        reduces to 0.0 as Z moves out to the boundaries of the
c                        extreme-Z-extrapolation range [zlo_ex,zhi_ex].
c
c  BY DEFAULT, the OPAL-opacity calculating routines set OPACT = 1.0E+35 and
c   return without actually calculating the opacity IF:
c     (1) FZEDGE = 0.0  , or
c     (2) FTREDGE = 0.0 and ( logR < -6 or logT < 3.97 )  .
c   Otherwise, even if FTREDGE = 0.0 , the radiative opacity is extrapolated
c   (linearly) without limit to high T or R, since an estimate of the radiative
c   opacity may be needed in such regions to determine whether the conductive
c   opacity suffices there or not.
c
c  IF YOU HAVE READ IN CONDUCTIVE OPACITIES, then FTREDGE will be non-zero
c   where they are valid and dominate, even if the radiative opacities are not
c   valid there: i.e., conductive opacities can be used to EXTEND the radiative
c   opacities, as well as being combined with them via the relevant formula
c     Kappa = 1 / ( 1 / Kappa_rad + 1 / Kappa_cond )  .
c  Also: FTREDGE will be unity in the density region where opacities switch
c   over from fully-valid radiative to fully-valid conductive ones, even if
c   part of this switchover region requires some extrapolation of one or both
c   of these.  However, FEDGE will be less than unity (possibly even zero) in
c   switchover regions where such such extrapolation is required, and also in
c   density gaps where different conductive opacity tables do not quite meet.
c  (Also, at high T and R, an extrapolated conductive opacity value is returned
c   even in regions where FTREDGE is zero.)
c
c  NOTE THAT, if you have set the error-checking level to 2 (see SET_ERR_CHECK
c   below), then ANY "out-of-range" case (where the final value of FEDGE = 0.0)
c   is considered a fatal error and the program halts.
c
c  If FZEDGE = 0.0, then the given Z-value lay too far ouside the available
c   Z-range to be extrapolated (this is checked first, before T6 and R).
c  If FTREDGE = 0.0 (and FZEDGE > 0.0), then the given T6 and/or R values lay
c   too far outside the available table for reasonable extrapolation.
c
c  Details of the extrapolation, and of subroutines allowing user control over
c  the boundaries, are discussed further below.
c
c
c*** OPAL_X_CNO_FU( xh, slt, slr, xmet, nmet, fu )  This subroutine adds any
c    ---------------------------------------------  opacity shifts due to the
c  interconversions C --> N, O --> N, and/or N --> Ne (which can arise from
c  nuclear burning) to the opacities interpolated in the 6 basic variables
c  { z, xh, exC, exO, slt, slr }.  USE OF THIS SUBROUTINE CAN BE TRICKY.
c
c ---WARNING--- This subroutine estimates Z from the mass fraction of elements
c  heavier than Ne.  UNLESS (1) you keep track of the mass fractions at least
c  of C, N, O, Ne, and "heavies", and (2) your initial Z-composition, namely
c  {C, N, O, Ne, "heavies"}, is THE SAME as that in the "solar" opacity table
c  (e.g., 'GN93hz', 'GS98hz', or 'AGS04hz'), this subroutine will obtain an
c  ERRONEOUS Z value and thus an INCORRECT OPACITY.
c
c ---WARNING--- If nmet = 19 in your array, then you must have initialized ALL
c  of {C,N,O,Ne,Na,Mg,Al,Si,P,S,Cl,Ar,K,Ca,Ti,Cr,Mn,Fe,Ni} to a "solar" opacity
c  table mix (e.g., from 'GN93hz' or 'GS98hz'), OTHERWSE you will get ERRONEOUS
c  Z and CNO-interpolation factors (since the program uses stored atomic weight
c  values to convert xmet into number fractions in this case), and thus an
c  INCORRECT OPACITY.  If you include either fewer or more heavy elements,
c  e.g., if you combine some of these elements into a collective "Xheavy", then
c  you MUST use a value of nmet NOT EQUAL TO 19.
c
c ---WARNING--- OPAL_X_CNO_FU implicitly assumes that elements heavier than Ne
c  are negligibly affected by nuclear burning.  IF ANY ELEMENTS HEAVIER THAN Ne
c  ARE PRODUCED VIA NUCLEAR BURNING, this will cause the Z-value estimated by
c  OPAL_X_CNO_FU to increase by roughly 5 to 6 times as much as the increase in
c  heavy element abundance.  This may give LESS GOOD OPACITY values, or even
c  yield estimated Z-values so large as to be OUT OF RANGE (this will occur for
c  Xheavy > 0.02, roughly; in the worst case, Xheavy > 0.015 may give estimated
c  Z > 0.1, i.e., beginning to be out of range).  If any elements heavier than
c  Ne are produced via nuclear burning, you may wish to assign all or most of
c  the newly-nucleosynthesized "heavies" to the Ne abundance, for purposes of
c  opacity calculation (or else use some other subroutine).
c
c  The input variables are:
c
c       xh      The hydrogen mass fraction, X  (as for OPAL or OPAC above)
c       slt     log10(T6) = log10(T) - 6  (as for OPAL above)
c       slr     log10(R) = log10(rho) - 3 * slt  (as for OPAL above)
c       xmet    SINGLE-PRECISION REAL ARRAY of size nmet, giving the mass
c                 fractions of the "metals", i.e., of C, N, O, Ne, ...
c                 NOTE that these are the actual mass fractions (NOT the mass
c                 fractions relative to Z), and any "excess" C or O should be
c                 included in the values of xmet(1) or xmet(3), respectively.
c                 By definition, the mass fraction Y of helium is given by
c                 Y = 1 - xh - SUM{xmet(i)}  , where i=1,...,nmet in the SUM.
c       nmet    INTEGER size of the array xmet: ideally it should be the case
c                 that  nmet = nel_zmix = 19  , in which case xmet is assumed
c                 to hold the mass fractions of the elements of the OPAL mix,
c                 namely, {C,N,O,Ne,Na,Mg,Al,Si,P,S,Cl,Ar,K,Ca,Ti,Cr,Mn,Fe,Ni}.
c                 If the array size  nmet  is not 19, then the sum of xmet(5)
c                 through xmet(nmet) is used as the total mass fraction of all
c                 elements heavier than Ne, i.e., the array xmet must contain
c                 at least {C,N,O,Ne,Xheavy}.
c               NOTE that if Xheavy contains any part of the abundances from C,
c                 N, O, or Ne, then the calculated Z value will be in error!
c               (Also, if you have set the error level to 3 or higher [see the
c                 subroutine SET_ERR_CHECK] and CNO-interpolation is available,
c                 then it is a fatal error if nmet is not equal to 19.)
c       fu      SINGLE-PRECISION REAL variable, giving the fraction of the
c                 opacity shifts to be applied from any user-specified file: fu
c                 multiplies opacity differences between the files CF_USER and
c                 CF_HZ (as specified by the subroutine READ_EXTENDED_OPAC:
c                 see below).
c               If NO user-specified opacity file CF_USER has been read in,
c                 then the value of  fu  is ignored (a value of 0.0 is used).
c
c  This subroutine uses the array  xmet(nmet)  to calculate the metallicity Z,
c  the excess carbon and oxygen EXC and EXO, and the fractions FCN, FCON, and
c  FCNONE (to apply the C --> N, O --> N, and N --> Ne opacity shifts --- the
c  CNO-interpolation of logKappa is linear in the CNO number fractions).  In
c  general, it sets  FUSE = fu  (except that the value of FUSE is restricted
c  so that it does not correspond to a reduction by more than a factor of 2 in
c  the total number density of elements heavier than Ne).  This subroutine then
c  does the equivalent of calling
c    OPAL_F_CNOU( Z, xh, EXC, EXO, slt, slr, FCN, FCON, FCNONE, FUSE )  .
c
c  NOTE that there would usually be little point in using OPAL_X_CNO_FU unless
c  you have called   READ_EXTENDED_OPAC  with a non-zero value of  I_CNO  (to
c  allow CNO-interpolation in the opacities) and/or a non-blank  CF_USER  value
c  (the user-specified opacity correction filename).
c    If the CNO-interpolation opacity files have not been read in, then this
c  subroutine approximates the opacity effects of C,N,O,Ne interconversion by
c  applying small negative and/or positive values of exC and exO ("excess-C,O")
c  which may or may not be better than nothing.
c
c  NOTE that interconversion of C,N,O,Ne via CNO-cycle burning changes slightly
c  the value of Z that this subroutine will compute, for a given set of mass
c  fractions of elements heavier than Ne: the total number density in C,N,O,Ne
c  is constant, but the total mass in these elements changes.  Thus this
c  subroutine OPAL_X_CNO_FU should only be used if one has read in a RANGE of
c  Z-values (see opacity-reading subroutines below): if one has read in only a
c  single Z-value, then OPAL_X_CNO_FU is likely to yield out-of-range Z values.
c
c  Note that the subroutine SET_CNO_FILES( cf_hz, cf_c, cf_o, cf_n, cf_user )
c  (discussed below) can be used to set the names of the opacity files that are
c  used to get the opacity shifts for CNO-interconversion (files cf_hz through
c  cf_n) and any user-specified opacity shifts (cf_user, relative to cf_hz).
c  NOTE that the first four of these files (cf_hz, cf_c, cf_o, cf_n) are those
c  used for CNO-interpolation, and should all have the SAME number fractions
c  for the elements heavier than Ne in their compositions (only C,N,O,Ne should
c  be interconverted in these CNO-interpolation files).
c
c
c*** OPAL_F_CNOU( z, xh, exC, exO, slt, slr, fcn, fcon, fcnone, fu )  For users
c    ---------------------------------------------------------------  who want
c  to use their own methods to compute the metallicity Z, the "excess" carbon
c  and oxygen mass fractions EXC and EXO, and CNO-interpolation factors FCN,
c  FCON, and FCNONE (as well as any user-factor FU) from their composition.
c
c  This interface is similar to  OPAL( z, xh, exC, exO, slt, slr )  except for
c  the added CNO/user-interpolation factors:
c
c       fcn     Multiplies opacity differences between files cf_c and cf_hz
c       fcon    Multiplies opacity differences between files cf_o and cf_hz
c       fcnone  Multiplies opacity differences between files cf_n and cf_hz
c       fu      Multiplies opacity differences between files cf_user and cf_hz
c
c  Note that the inputs supplied to the opacity-reading subroutines (described
c  below) control whether CNO-interpolation and/or user-interpolation opacity
c  files are read in.  If no CNO-interpolation files were read in, then the
c  values of  fcn, fcon, fcnone  are ignored; if no user-interpolation file was
c  read in, then the value of  fu  is ignored.
c
c  NOTE that all the previous opacity-calculating interfaces above ultimately
c  call the subroutine OPAL_F_XCON_CNOU (described further below); the values
c  of  Z, XH, EXC, EXO, SLT, SLR, FCN, FCON, FCNONE, FU  actually used can be
c  checked by calling the subroutine  ASK_LAST_XCNOU  described below.
c
c
c*** ASK_LAST_XCNOU( Z, X, XC, XO, SLT, SLR, FCN, FCON, FCNONE, FU )
c    ---------------------------------------------------------------
c  This subroutine just returns the last-used OPAL_F_CNOU input values: it can
c  be used to check these values, rather than including common /x_opal_z/ in
c  the calling program.
c
c
c*** ASK_LAST_OPAC( OPACT, DOPACT, DOPACR, DOPACTD, FEDGE, FTREDGE, FZEDGE )
c    -----------------------------------------------------------------------
c  This subroutine just returns the last-computed opacity values, taken from
c  common /e_opal_z/ (as an alternative to including this common block in the
c  calling program), as described above (under the OPAC and OPAL routines).
c
c
c*** ASK_OPAL_Z_MIX( IMIX, XIZ, N_X, FNINZ, N_N )
c    --------------------------------------------
c  For the mix specified by  IMIX  , this subroutine returns the components of
c  the metallicity Z, in the arrays  XIZ(N_X)  and  FNINZ(N_N)  ; note that up
c  to 19 components are returned, the ratios by mass and by number respectively
c  of {C,N,O,Ne,Na,Mg,Al,Si,P,S,Cl,Ar,K,Ca,Ti,Cr,Mn,Fe,Ni}.  Mix specs are:
c
c   IMIX = 9 (actually, any IMIX > 5 or < -10) : return the actual mixture used
c   IMIX = 1 : return the 'GN93hz' main solar mix
c   IMIX = 2 : return the 'Alrd96a2' [O/Fe] = 0.3 mix
c   IMIX = 3 : return the 'C95hz' [O/Fe] = 0.4 mix
c   IMIX = 4 : return the 'W95hz' [O/Fe] = 0.5 mix
c   IMIX = 5 : return the user-specified [O/Fe] > 0 mix
c   IMIX = 0 : return the meteoritic mix
c   IMIX = -1 : return the alternate main solar mix (default 'GS98hz')
c   IMIX = -2 : return the corresponding version of 'Alrd96a2' [O/Fe] = 0.3 mix
c   IMIX = -3 : return the corresponding version of 'C95hz' [O/Fe] = 0.4 mix
c   IMIX = -4 : return the corresponding version of 'W95hz' [O/Fe] = 0.5 mix
c   IMIX = -5 : return the corresponding user-specified [O/Fe] > 0 mix
c   IMIX = -6 : return the "default-CNO" mix (for CNO-interpolation)
c   IMIX = -7 : return the CtoN mix (for CNO-interpolation)
c   IMIX = -8 : return the COtoN mix (for CNO-interpolation)
c   IMIX = -9 : return the CNOtoNe mix (for CNO-interpolation)
c   IMIX = -10 : return the user-defined nonCNO-interpolation mix
c
c
c*** ASK_OPAL_MIX_WT( ATwt, Nwt, ATwtHHe, NHHe, ATz, Nz )  This subroutine
c    ----------------------------------------------------  returns the atomic
c  weights and nuclear charges used for the components of the metallicity Z:
c
c    ATwt(Nwt) = real array returning up to 19 atomic weight values, as used
c                  for {C,N,O,Ne,Na,Mg,Al,Si,P,S,Cl,Ar,K,Ca,Ti,Cr,Mn,Fe,Ni};
c                  if Nwt < 19 then only Nwt values will be returned, and
c                  if Nwt < 1 then no atomic weight values will be returned.
c    ATwtHHe(NHHe) = real array returning up to 2 atomic weight values, as used
c                      for H and He.
c    ATz(Nz) = real array returning up to 19 atomic numbers (nuclear charges),
c               for {C,N,O,Ne,Na,Mg,Al,Si,P,S,Cl,Ar,K,Ca,Ti,Cr,Mn,Fe,Ni}.
c
c
c             ================================================
c             The subroutines that read in the OPAL opacities:
c             ================================================
c
c
c*** READ_OPAL_DUMP( IU, CF_D )  If a binary opacity file was created at some
c    --------------------------  earlier time by DUMP_OPAL_OPAC below, then
c  this subroutine can read it in again; note that ALL opacities and user
c  settings are restored from this unformatted binary file.
c  NOTE that the only advantage of this is speed: reading such an opacity
c  dumpfile is MUCH faster than using READ_BASIC_OPAL_OPAC (or its alternates).
c
c    IU = integer Fortran unit number: from 1 to 99, and not equal to 5 or 6;
c             negative value means "use previous/default value" (if no positive
c             Fortran unit number was ever given earlier, the default is 23).
c    CF_D = character string: name of opacity dumpfile to be read in (INCLUDING
c             THE DIRECTORY, if it is not a local file).  NOTE that this file
c             must exist, and must not be in compressed form.
c
c----[NOTE that the format of this dumpfile is INCONSISTENT with those produced
c  by program versions between FEBRUARY 1, 2004 and SEPTEMBER 6, 2006; any such
c  dumpfiles must be re-created by the present version.]
c
c
c*** DUMP_OPAL_OPAC( IU, CF_D )  AFTER you have read in the opacities (from the
c    --------------------------  plain-text OPAL opacity files) via one of the
c  subroutines below, this subroutine can be used to dump an unformatted binary
c  file of the current opacities and user settings (just as read in) for future
c  re-use by the subroutine READ_OPAL_DUMP above.  Note that if you have read
c  in conductive and/or molecular opacities as well (e.g., via the subroutine
c  READ_EXTENDED_OPAC below), then these will also be stored in the dumpfile.
c
c    IU = integer Fortran unit number: from 1 to 99, and not equal to 5 or 6;
c             negative value means "use previous/default value".
c    CF_D = character string: name of opacity dumpfile to be created (INCLUDING
c             THE DIRECTORY, if it is not a local file); this file will be
c             overwritten if it already exists.
c
c  The size of this opacity dumpfile will depend on the number of Z-values
c  stored; typically, 'z14xcotrin21.f' will store the maximum number of 14, for
c  a size of about 24 Mb (while 'z5xcotrin21.f' can store at most 5, for 9 Mb;
c  'z1xcotrin21.f' will always store 1, for 2.7 Mb) [if no molecular opacities
c  were read in, these sizes will be 23 Mb, 8 Mb, and 1.7 Mb, respectively].
c
c  [But if you read opacities using  READZEXCO  (rather than one of the simpler
c  subroutines  READ_BASIC_OPAL_OPAC  or  READ_EXTENDED_OPAC  described below),
c  then the input argument  NZIN  determines how many Z-values are used.]
c
c
c*** SET_OPAL_DIR( cdirin )  The input character variable  cdirin  can be used
c    ----------------------  to specify the directory where the OPAL-opacity
c  ASCII files will subsequently be looked for (default is the local directory,
c  which can also be specified by supplying a blank argument to SET_OPAL_DIR).
c  Note: the total length of the directory name MUST NOT exceed 246 characters.
c
c  Example:      call set_opal_dir( '/home/username/opal_directory/' )
c
c  OR: to specify "look in local directory":      call set_opal_dir( ' ' )
c
c  OR: for a local subdirectory:      call set_opal_dir( 'opal_directory/' )
c
c
c*** SET_MOL_DIR( cdir_mol )  The input character variable  cdir_mol  specifies
c    -----------------------  the directory where the molecular-opacity ASCII
c  files will subsequently be looked for (blank input means "use the default":
c  i.e., try both the OPAL directory and the local directory).
c
c
c*** SET_COND_DIR( cdir_cond )  The input character variable  cdir_cond  gives
c    -------------------------  the directory where conductive-opacity ASCII
c  files will subsequently be looked for (blank input means "use the default":
c  i.e., try both the OPAL directory and the local directory).
c
c
c*** SET_OPAL_LIST_LEVEL( LIST_LEVEL )  This subroutine can be used to make the
c    ---------------------------------  opacity-reading routines print out the
c  ASCII opacity files that are actually read in (this can be useful when one
c  uses a subroutine such as READ_EXTENDED_OPAC to read in the "best available"
c  Ferguson molecular opacities, for example):
c
c    LIST_LEVEL = integer flag to determine whether names of the ASCII opacity
c                   files that are read in are printed out as they are read in
c                   (note that binary opacity dump-files are NEVER printed).
c                 The input value of  LIST_LEVEL  has the following effect:
c                    0 : (default) NO listing (printout) of opacity file names.
c                    1 : print the first Type 2 OPAL opacity (Gz???.x??) file,
c                          the first of each Ferguson molecular opacity case
c                          (or Alexander file), any conductive opacity file(s),
c                          and any Type 1 OPAL opacity file(s) (e.g., 'GN93hz',
c                          'GS98hz', 'AGS04hz', 'W95hz', 'AGS04hz_Ofe.5_W95',
c                          'GS98hz.CtoN', 'GS98hz.COtoN', 'GS98hz.CNOtoNe'...).
c                    > 1 : up to  LIST_LEVEL  Type 2 OPAL opacity files will be
c                            printed, and up to  LIST_LEVEL  of each Ferguson
c                            case read in (this is seldom useful, but for
c                            example one might use LIST_LEVEL of 9999 to
c                            print out EVERY opacity file that is read in).
c
c
c*** SET_OPAL_LIST_UNIT( LIST_IU )  Set the integer Fortran unit number for the
c    -----------------------------  above list output (default is 6, i.e., the
c  standard output).  An input value of 5, of more than 99, or less than 0,
c  will be reset to the default of 6 (standard output).  [Note that if the
c  value of  LIST_IU  coincides with one of the Fortran units used to actually
c  read in an opacity file, a warning will be printed to the standard output,
c  and all subsequent list output will be printed to the standard output.]
c
c
c*** READ_BASIC_OPAL_OPAC( IU, Z, CF_HZ, OFEBRACK, CF_OFE )  Read in the basic
c    ------------------------------------------------------  OPAL opacities,
c  possibly for non-solar alpha-element abundances (i.e., non-zero [O/Fe]):
c
c    IU = integer Fortran unit number: from 7 to 96; note IU through IU+3 may
c           be used (negative value means "use previous/default value").  Note
c           that values from 0 to 6 will be reset to 7, and values greater than
c           96 will be reset to 96.
c    Z = (real) "typical" metal-mass-fraction value; opacities will be read in
c          for as wide a range around Z as possible (negative means "use the
c          default value of 0.02").  For the version  z14xcotrin21.f  of these
c          subroutines, the value of Z is irrelevant, as ALL of the available
c          metallicities will be read in (from 0.0 to 0.1).  For  z5xcotrin21.f
c          metallicities within about a factor of two of Z will be available;
c          for  z1xcotrin21.f  on the the single metallicity Z will be read in.
c    CF_HZ = character variable (or string constant) giving the "main" opacity
c              file to read in, typically 'GN93hz', 'GS98hz', or 'AGS04hz' (but
c              one can specify any Type-1 OPAL opacity file having a solar mix;
c              blank means "use the default of 'GN93hz'").  NOTE that not only
c              will this file  CF_HZ  be read in, but ALSO the file 'GN93hz'
c              and the 40 Type-2 files (Gz???.x??).
c    OFEBRACK = (real) value of [O/Fe] = log{ (n_O/n_Fe) / (n_O/n_Fe)_Sun } ;
c                 if this is non-zero, then opacities are interpolated between
c                 the file  CF_HZ  and the file  CF_OFE  to get opacities for
c                 the given [O/Fe] value.
c    CF_OFE = character variable (or string constant) giving the name of the
c               OPAL opacity file with non-zero [O/Fe]; if OFEBRACK = 0.0, then
c               this argument is ignored (blank means "use the default": for
c               CF_HZ = 'GN93hz' the default is CF_OFE = 'W95hz', otherwise the
c               default is to append '_Ofe.5_W95' to the value of CF_HZ).
c
c ----- NOTE that if the opacity files on disk are in compressed form (suffix
c         '.gz', '.Z', or '.bz2'), then they will be uncompressed (by gunzip,
c         uncompress, or bunzip2, respectively), read in, and compressed again;
c         however, this slows down the input and MAY LEAD TO INPUT ERRORS if
c         more than one instance of this program is running.
c
c
c*** READ_EXTENDED_OPAC(IU,Z,CF_HZ,OFEBRACK,CF_OFE,I_MOL,I_COND,I_CNO,CF_USER)
c    -------------------------------------------------------------------------
c  This is an extended version of the above subroutine READ_BASIC_OPAL_OPAC:
c
c    IU, Z, CF_HZ, OFEBRACK, CF_OFE : as in READ_BASIC_OPAL_OPAC above.
c    I_MOL = flag controlling whether the low-temperature molecular opacities
c              will be used.  The most useful values are as follows:
c            I_MOL = 0 : do not read in any molecular opacities
c            I_MOL = 1 : look for molecular opacities for the same composition
c                          as the OPAL opacities (if no matching molecular set
c                          of opacities can be found, look for any available
c                          set of molecular opacities).  If  OFEBRACK  is not
c                          zero, try to add opacity-shifts to get opacities
c                          appropriate for this input [O/Fe] value.
c            I_MOL = -1 : read the molecular opacities, but do not use them to
c                           extend the OPAL opacities to low T when using the
c                           OPAL opacity-calculating subroutines described
c                           above [the molecular opacities can be accessed by
c                           the subroutine KAP_MOL, described further below].
c            I_MOL = 21, 31, 41, ... 121 : read ONLY the corresponding set of
c                           Fergson 2005 molecular opacities (21=GN93, 31=GS98,
c                           41=L03, 51=AGS04, 61=S92, 71=S92AE, 81=GS98-.2,
c                           91=GS98+.2, 101=GS98+.4, 111=GS98+.6, 121=GS98+.8).
c            I_MOL = 991 : read ONLY the molecular opacities specified by a
c                     previous call to SET_FERG_USER (described further below).
c          ------[A more-detailed dexcription of I_MOL than most users will
c                need follows the descriptions of the other input variables.]
c    I_COND = flag controlling whether the high-density conductive opacities
c               will be read in and/or used:
c                 0 = do not use these high-RHO conductive opacities at all.
c                 1 = read these opacities in, and use them to extend the OPAL
c                       opacities to high RHO when using opacity-calculating
c                       subroutines described above.  By default, the file
c                       'condall06.d' (Potekhin et al. 2006) is used; if not
c                       found, 'condall06' is tried; if not found, then the OLD
c                       file 'Condopac' (Hubbard & Lampe 1969) is used; if none
c                       of these are found, it is a fatal error.
c                 2 = same as 1, except that only the Potekhin et al. (2006)
c                       file ('condall06.d' or 'condall06') is looked for.
c                -1 = same as 1, but do not use conductive opacities to extend
c                       the OPAL opacities when using the opacity-calculating
c                       subroutines described above (they can be accessed by
c                       the subroutine KAPCOND, described further below).
c                -2 = same as -1, except that only the Potekhin et al. (2006)
c                       file ('condall06.d' or 'condall06') is looked for.
c    I_CNO = flag controlling whether the varied-CNO opacities will be used:
c              0 = these varied-CNO opacities will neither be read in nor used.
c              1 = these varied-CNO opacities will be read in from files with
c                    names given by appending '.CtoN', '.COtoN', and '.CNOtoNe'
c                    to the name given by the input  CF_HZ  , and will be
c                    available to use with the opacity-calculating subroutine
c                    OPAL_X_CNO_FU (or OPAL_F_CNOU) described above.
c    CF_USER = character variable (or string constant) giving the name of a
c                user-specified Type-1 OPAL opacity file to read in, for use
c                with OPAL_X_CNO_FU (or OPAL_F_CNOU); a blank input string
c                means that no such file will be read in or used.
c
c ----- A more detailed description of  I_MOL  and its allowed values
c                               (MOST USERS WILL NOT NEED TO BOTHER WITH THIS):
c    I_MOL = flag controlling whether the low-temperature molecular opacities
c              will be used.  IF IT IS NON-ZERO, then if possible Ferguson et
c              al. (2005) molecular opacities MATCHING the OPAL opacity file
c              will be read in; IF no such matching files are found, then all
c              possible molecular opacity files are checked for, and the first
c              one found is read in -- looking first for a user-specified case
c              (see SET_FERG_USER below), next for a case specified by a prior
c              call to the subroutine SET_ALEX_FILE (see below), next for the
c              cases AGS04, L03, GS98, GN93, S92, S92AE, GS98-.2 ... GS98+.8;
c              if none of these are found, the Alexander & Ferguson (1994)
c              opacities will be read in from the file 'Alexopac'; if not even
c              this file is found, then it is a fatal error.
c           --- If one of the non-alpha-enhanced Ferguson et al. 2005 cases was
c              read in, and  abs(I_MOL) < 10  and the input value of  OFEBRACK
c              is non-zero, then an attempt will be made to read in files so as
c              to obtain opacity-shifts to yield opacities for this specified
c              [O/Fe] value, using the GS98 GS98-.2 ... GS98+.8 cases if these
c              are available, or if not then the S92 and S92AE cases are tried.
c           --- The input value of  I_MOL  also has the following effects:
c            For the (DEFAULT) Ferguson et al. 2005 case:
c                0 = do not use low-T molecular opacities at all.
c                1 = the molecular opacities are read in, and will be used
c                      to extend the OPAL opacities to low T when using the
c                      opacity-calculating subroutines described above;
c                      the edge factor FKAEDGE will be unity for XZCO < 0.1
c                      (where  XZCO = Z + exC + exO  is the total metal mass
c                      fraction), and FKAEDGE will go to
c                      zero for XZCO > 0.12;
c                2 = same as I_MOL = 1
c                3 = same as I_MOL = 1
c                4 = similar to I_MOL = 1, but set edge factor FKAEDGE to zero
c                      for too much "excess-CO":  abs(exC) + abs(exO) > CO_lim
c                      where CO_lim = 0.2 * max( Z , 0.0001 , Z + exC + exO )
c                      [this will not be done if you just call the subroutine
c                      KAPFERG (which does not know what Z, exC, and exO are),
c                      but it WILL be done for any other subroutine, including
c                      KAP_MOL, KAPFERG, and any calls to molecular opacity
c                      routines from OPAL-opacity calculating subroutines].
c            For the (OLD) Alexander & Ferguson 1994 case:
c                0 = do not use low-T molecular opacities at all.
c                1 = the molecular opacities are read in; arbitrary values of
c                      XZCO  will be allowed at X = 0, and  XZCO < 0.1  will be
c                      allowed at all X (the edge factor FKAEDGE will go to
c                      zero for XZCO > 0.15 at X > 0.03).
c                2 = similar to I_MOL = 1, but always reduce the edge factor
c                      FKAEDGE to zero as XZCO increases from 0.1 to 0.15,
c                      even for X = 0.
c                3 = similar to I_MOL = 2, but restrict to regions where the
c                      Alexander tables were available (0.0001 < XZCO < 0.03,
c                      the original table range), and set the edge factor
c                      FKAEDGE to zero for  XZCO < 0.00005  or XZCO > 0.05 .
c                4 = similar to I_MOL = 3, but set edge factor FKAEDGE to zero
c                      for too much "excess-CO".
c            For both types of molecular opacities:
c               -1 = read in the molecular opacities, but do not use them to
c                      extend the OPAL opacities to low T when using the OPAL
c                      opacity-calculating subroutines described above [the
c                      molecular opacities can be accessed by the subroutine
c                      KAP_MOL (or KAPFERG or KAPALEX), described further
c                      below].  Otherwise, same as I_MOL = 1.
c               -2 = same as I_MOL = -1, with Z-constraints as for I_MOL = 2
c               -3 = same as I_MOL = -1, with Z-constraints as for I_MOL = 3
c               -4 = same as I_MOL = -1, with Z-constraints as for I_MOL = 4
c            Other input values of  I_MOL  allow one to specify precisely which
c            Ferguson et al. 2005 case to read in (note that for the following
c            cases, NO [O/Fe]-molecular-opacity-shifts will be done):
c               11 thru 14, or -11 thru -14 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson et al. 2005 case specified
c                      by a previous call to SET_ALEX_FILE is looked for.
c               21 thru 24, or -21 thru -24 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson GN93 case is looked for ...
c               31 thru 34, or -31 thru -34 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson GS98 case is looked for ...
c               41 thru 44, or -41 thru -44 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson L03 case is looked for ...
c               51 thru 54, or -51 thru -54 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson AGS04 case is looked for ...
c               61 thru 64, or -61 thru -64 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson S92 case is looked for ...
c               71 thru 74, or -71 thru -74 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson S92AE case is looked for ...
c               81 thru 84, or -81 thru -84 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson GS98-.2 case is looked for ...
c               91 thru 94, or -91 thru -94 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson GS98+.2 case is looked for ...
c              101 thru 104 or -101 thru -104 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson GS98+.4 case is looked for ...
c              111 thru 114 or -111 thru -114 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson GS98+.6 case is looked for ...
c              121 thru 124 or -121 thru -124 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only the Ferguson GS98+.8 case is looked for ...
c              991 thru 994 or -991 thru -994 : same as 1 thru 4 or -1 thru -4,
c                      EXCEPT: only a user-specified Ferguson case is looked
c                      for (as previously set by calling SET_FERG_USER).
c
c
c******************************************************************************
c
c
c  **************************************************************************
c  SUBROUTINES TO CONTROL THE DETAILS: MOST USERS WILL NOT NEED TO USE THESE:
c  **************************************************************************
c
c
c******* NOTE that the opacity-reading subroutines described above call various
c  versions of the subroutines described below; for example, calling
c    READ_BASIC_OPAL_OPAC( IU, Z, CF_HZ, OFEBRACK, CF_OFE )
c  does the equivalent of:
c      CALL SET_ALTMIX_MAIN_FILE( CF_HZ )
c      CALL SET_OFE_FILE( CF_OFE )
c      CALL SET_ALTMIX_OFE_FILE( CF_OFE )
c      CALL READZEXCO( -9, -1.0, z, -1.0, khighz, IU, OFEBRACK )
c  with a value of  khighz  determined by the inputs  CF_HZ  and  OFEBRACK;
c  likewise, calling
c    READ_EXTENDED_OPAC(IU,Z,CF_HZ,OFEBRACK,CF_OFE,I_MOL,I_COND,I_CNO,CF_USER)
c  does the equivalent of:
c      CALL SET_ALTMIX_MAIN_FILE( CF_HZ )
c      CALL SET_OFE_FILE( CF_OFE )
c      CALL SET_ALTMIX_OFE_FILE( CF_OFE )
c      CALL SET_CNO_FILES( ' ', ' ', ' ', ' ', CF_USER )
c      CALL READZEXCO( -9, -1.0, Z, -1.0, khighz, IU, OFEBRACK )
c      CALL READ_BEST_MOL( IU, I_MOL, CF_HZ, OFEBRACK )
c      IF ( IABS( I_COND ) .GT. 1 ) THEN
c         CALL READ_COND_POT( IU )
c      ELSE IF ( I_COND .NE. 0 ) THEN
c         CALL READCOND( IU )
c      ENDIF
c      CALL SET_COND_USE( MIN(1,MAX(0,I_COND)), 99 )
c  where the value of  khighz  is determined by the various inputs.
c
c  Likewise, the opacity-calculating subroutines  OPAC, OPAL, OPAL_X_CNO_FU,
c  and OPAL_F_CNOU  will call  OPAL_F_XCON_CNOU,  which then calls one or more
c  of the subroutines  OPAL_K_ONLY, KAPCOND, KAPFERG, KAPALEX  described below.
c
c
c    =====================================================================
c    Other subroutines that interpolate among the OPAL or other opacities:
c    =====================================================================
c
c
c*** OPAL_K_ONLY( Z, XH, EXC, EXO, SLT, SLR, FCN, FCON, FCNONE, FU )  This is
c    ---------------------------------------------------------------  almost
c  the same as OPAL_F_CNOU, with the same meaning for the inputs, EXCEPT that
c  it will only return the OPAL opacities (i.e., it ignores molecular opacities
c  and conductive opacities, whether or not these have been read in).
c
c
c*** KAPFERG( slt, slr, xh, z, exC, exO, FLKA, DLKATR, DLKARO, DLKAT, FKAEDGE )
c    --------------------------------------------------------------------------
c  This routine interpolates and returns the Ferguson et al. 2005 molecular
c  opacity (provided that a set of these opacities has been read in)  [NOTE
c  that if these Ferguson et al. 2005 molecular opacities are available, then
c  the Alexander & Ferguson 1994 molecular opacities are not, and vice versa]:
c
c    slt, slr, xh, z, exC, exO = (real) input values, as in subroutine OPAL.
c    FLKA = (real) variable returning Log(kappa), equivalent to OPACT
c    DLKATR = (real) variable returning dLog(kappa)/dLog(T) at constant R,
c               equivalent to DOPACT
c    DLKARO = (real) variable returning dLog(kappa)/dLog(RHO) at constant T,
c               equivalent to DOPACR
c    DLKAT = (real) variable returning dLog(kappa)/dLog(T) at constant density,
c              equivalent to DOPACTD
c    FKAEDGE = (real) variable returning the edge factor, equivalent to FEDGE
c
c
c*** CACHEFERG( ksto, xh, xzco )  This subroutine caches Z- and X-interpolated
c    ---------------------------  Ferguson et al. 2005 molecular opacity values
c  for future use [if a LARGE number of low-termperature opacities must be
c  evaluated with the same Z and X values, this can speed up the evaluation].
c    ksto = (integer) storage index, 1 or 2, of the cache storage area (only
c             two sets of Z- and X-interpolated opacities can be cached, at
c             X1,Z1 and X2,Z2).
c    xh = X, (real) hydrogen mass fraction to use.
c    xzco = Z + exC + exO, (real) total metal mass fraction to use.
c
c
c*** KAP_MOL( slt, slr, xh, z, exC, exO, FLKA, DLKATR, DLKARO, DLKAT, FKAEDGE )
c    --------------------------------------------------------------------------
c  This routine just calls either KAPFERG (see above) or KAPALEX (see below),
c  depending on which type of molecular opacities are available.
c
c
c*** KAPALEX( FLT, FLRO, X, XZCO, FLKA, DLKAT, DLKARO, FKAEDGE )  This routine
c    -----------------------------------------------------------  interpolates
c  and returns the Alexander & Ferguson 1994 molecular opacities (provided that
c  these opacities have been read in from the file 'Alexopac')  [NOTE that if
c  these Alexander & Ferguson 1994 molecular opacities are available, then the
c  Ferguson et al. 2005 molecular opacities are not, and vice versa]:
c
c    FLT = log(T) = SLT + 6.0
c    FLRO = log(RHO) = SLR + 3.0 * SLT
c    X = hydrogen mass fraction (the same as XH above)
c    XZCO = Z + exC + exO = 1 - X - Y = the total mass fraction of elements
c             heavier than helium (note that the Alexander & Ferguson 1994
c             opacities are available only as a function of temperature,
c             density, hydrogen abundance, and metallicity)
c    FLKA = (real) variable returning Log(kappa), equivalent to OPACT
c    DLKAT = (real) variable returning dLog(kappa)/dLog(T) at constant density,
c              equivalent to DOPACTD
c    DLKARO = (real) variable returning dLog(kappa)/dLog(RHO) at constant T,
c               equivalent to DOPACR
c    FKAEDGE = (real) variable returning the edge factor, equivalent to FEDGE
c
c
c*** ASK_LAST_ALEX_EDGE( FKAEDGE, FTRA, FTRA_LO, FTRA_HI, FZKAEDGE )  To give
c    ---------------------------------------------------------------  access to
c  the detailed edge factors for the molecular opacities (which yielded the
c  final overall value of FKAEDGE, as returned by KAPFERG or KAPALEX above):
c
c    FKAEDGE = real variable returning the final overall edge factor; it is
c                defined as  FKAEDGE = FTRA * FZKAEDGE  .
c    FTRA = real variable returning the temperature-density edge factor, which
c             is defined as  FTRA = min( FTRA_LO , FTRA_HI )  .
c    FTRA_LO = real variable returning the edge factor for the low T, low RHO
c                edges of the molecular opacity tables.
c    FTRA_HI = real variable returning the edge factor for the high T, high RHO
c                edges of the molecular opacity tables.
c    FZKAEDGE = real variable returning the molecular Z-edge factor, in the
c                 manner determined by the value of  KALEX  as set by the
c                 subroutine  READ_EXTENDED_OPAC  (or SET_ALEX_USE below).
c
c
c*** SET_ALEX_USE( KALEX )  This allows the user to control whether molecular
c    ---------------------  opacities that were read in will actually be used,
c  and how; it may be called at any time to change this behavior:
c
c    KALEX = integer input flag controlling handling of molecular opacities:
c              if KALEX > 0, then the OPAL-opacity-calculating subroutines will
c                               use the molecular opacities (if they have been
c                               read in) as an extension to lower T;
c              if KALEX < 0 or KALEX = 0, then the OPAL opacity-calculating
c                               subroutines will ignore the molecular opacities
c                               whether or not they have been read in (but the
c                               subroutine KAPFERG or KAPALEX will still work).
c              Specific values for KALEX control the molecular-opacity Z-edge
c              factor, whether called from OPAL-opacity-calculating subroutines
c              or from the subroutines KAPFERG or KAPALEX:
c               1 : (DEFAULT) For Ferguson et al. 2005 opacities, the Z-edge
c                    factor FZKAEDGE is unity for XZCO < 0.10 at all X, and
c                    goes to zero for XZCO > 0.12; but for the Alexander 1994
c                    opacities, FZKAEDGE is unity for X = 0 at all XZCO and for
c                    XZCO < 0.10 at all X, and it goes to zero at XZCO > 0.15
c                    and X > 0.03 (note that XZCO = 1 - X - Y = Z + exC + exO).
c               2 : For Ferguson et al. 2005, same meaning as KALEX = 1; but
c                    for Alexander 1994, FZKAEDGE goes to zero for XZCO > 0.15
c                    at all X.
c               3 : For Ferguson et al. 2005, same meaning as KALEX = 1; but
c                    for Alexander 1994, restrict to the regions where tables
c                    were available (not extrapolated or otherwise created):
c                      FZKAEDGE = 1.0 for 0.0001 < XZCO < 0.03, and goes to
c                      FZKAEDGE = 0.0 for XZCO < 0.00005 or XZCO > 0.05 .
c               4 : FOR THE OPAL-OPACITY-CALCULATING SUBROUTINES and KAPFERG:
c                    for BOTH the Ferguson et al. 2005 and the Alexander 1994
c                    cases: multiply the FZKAEDGE value from case 3 above by a
c                    factor that is unity if  exC  and  exO  are both zero,
c                    and which goes to zero if  abs(exC) + abs(exO) > CO_lim
c                    for  CO_lim = 0.2 * max( Z , 0.0001 , Z + exC + exO ) .
c                    [Note that this constraint cannot be applied in KAPALEX,
c                    which does not know the separate values of Z, exC, exO
c                    (but only their sum XZCO); thus, for calls to KAPALEX
c                    itself, KALEX = 4 has the same effect as KALEX = 3.]
c               0 : Same as KALEX = -1.
c              -1 thru -4 : molecular opacities should NOT be used by the OPAL
c                    opacity-calculating routines, even if they are read in;
c                    same as 1 thru 4 when KAPFERG is called explicitly;
c                    same as 1 thru 3 when KAPALEX is called explicitly.
c              -9 : Set KALEX to its default value of 1.
c             -99 : Leave the current value of KALEX unchanged.
c
c
c*** ASK_ALEX_USE( KALEX, KALEX_AVAIL, ITYPE )  This subroutine returns the
c    -----------------------------------------  current value of these integer
c  flags that control the use of molecular opacities (see SET_ALEX_USE above):
c
c    KALEX = integer variable returning the value of KALEX as in SET_ALEX_USE.
c    KALEX_AVAIL = integer variable returning a flag value telling whether (and
c                    which) molecular opacities are actually available:
c                      0 : not available (molecular opacities never read in).
c                      1 : Alexander & Ferguson 1994 molecular opacities are
c                            available (the file 'Alexopac' has been read in):
c                            subroutine KAPALEX can be used to return Alexander
c                            opacities, and if KALEX > 0 then these will be
c                            used to extend the OPAL opacities to low T.
c                      2 : some set of Ferguson et al. 2005 molecular opacities
c                            is available; subroutine KAPFERG can be used to
c                            return these, and if KALEX > 0 then these will be
c                            used to extend the OPAL opacities to low T.
c    ITYPE = integer variable returning a flag value, whose meaning depends on
c               which type of molecular opacities are available:
c             ITYPE = ITYPE_FERG for Ferguson et al. 2005 molecular opacities:
c              the index of the (last) type of Ferguson opacities that were
c              read in (note that if several types of Ferguson opacities were
c              combined using READ_ADD_FERG or ADDFILE_FERG, the index refers
c              to the last type to be read in and combined):
c                   1 = case specified by CFILE_ALEX (see SET_ALEX_FILE below),
c                   2 = GN93 case,      3 = GS98 case,      4 = L03 case,
c                   5 = AGS04 case,     6 = S92 case,       7 = S92AE case,
c                   8 = GS98-.2 case,   9 = GS98+.2 case,  10 = GS98+.4 case,
c                  11 = GS98+.4 case,  12 = GS98+.8 case,
c                  99 = user-specified case (see SET_FERG_USER above).
c             ITYPE = IRHOSW for Alexander & Ferguson 1994 molecular opacities:
c              integer variable returning a flag value telling whether there is
c              a density switchover between OPAL and Alexander opacity tables
c              (as well as the temperature switchover which must be present)
c              [see subroutine SET_ALEX_DO_RHOSW described further below; note
c              Ferguson et al. 2005 opacities NEVER have a density switchover].
c
c
c*** KAPCOND( FLRO, FLT, X, Y, XCN, XON, XNEHEAVY, FMUAINV, FMUEINV,
c             ZSQBAR, IDER, FLKC, FLKCT, FLKCRO, FKCEDGE, FKCOK )
c    ---------------------------------------------------------------
c  This subroutine calculates and returns the conductive opacities.
c
c  If the file 'condall06.d' was read in, use the Potekhin et al. 2006 tables;
c  whether RMS or linear mean ionic charge is used depends on IDER (see below),
c  where  Zion(rms)    = (<z^2)^0.5 = sqrt( ZSQBAR / FMUAINV )  ,
c         Zion(linear) = <z>        = FMUEINV / FMUAINV  .
c
c  Alternatively, if the file 'Condopac' was read in instead, use the Hubbard &
c  Lampe 1969 tables, possibly extended and modified by formulae of Itoh et al.
c  1983 and Mitake et al. 1984, depending on the value of IDER (see below).
c
c    FLRO = log(RHO) = SLR + 3.0 * SLT
c    FLT = log(T) = SLT + 6.0
c    X = hydrogen mass fraction (the same as XH above).
c    Y = helium mass fraction.
c    XCN = Xc + Xn / 2 = effective total carbon mass fraction.
c    XON = Xo + Xn / 2 = effective total oxygen mass fraction.
c    XNEHEAVY = Xne + Xheavy = mass fraction of elements heavier than oxygen
c                 [by definition,  X + Y + XCN + XON + XNEHEAVY = 1].
c    FMUAINV = 1 / mu_A = SUM_i{ X_i / A_i }  (for all elements i in the mix --
c                note that X_i is the mass fraction and A_i the atomic weight);
c                if FMUAINV < 0.0, then an approximate value is calculated from
c                the input values of X, Y, XCN, XON, and XNEHEAVY.
c    FMUEINV = 1 / mu_e = SUM_i{ X_i * z_i / A_i }  (for all elements i in the
c                mix -- note that z_i is the atomic number of element i);
c                if FMUEINV < 0.0, then an approximate value is calculated.
c    ZSQBAR = <z^2> / mu_A = SUM_i{ X_i * (z_i)^2 / A_i }  (for all elements i
c                in the mix); this is the mean square ionic charge <z^2>
c                divided by mu_A (i.e., multiplied by FMUAINV) for the mixture;
c                if ZSQBAR < 0.0, then an approximate value is calculated.
c    IDER = flag controlling which conductive opacities are returned.
c             For the (DEFAULT) Potekhin 2006 ('condall06.d') case:
c               1 : bi-quadratic interp, Zion = (<z^2)^0.5, with derivatives;
c                     NOTE:  Zion(rms) = (<z^2)^0.5 = sqrt( ZSQBAR / FMUAINV );
c                     if it is necessary to extrapolate in log(Zion), do linear
c                     extrapolation using the (quadratic) slope at the edge of
c                     the matrix; if it is necessary to extrapolate in logT or
c                     logRHO, do linear extrapolation using the slope of the 2
c                     points at the edge of the matrix (this linear formula is
c                     mixed with a quadratic if one moves inside the edge of
c                     the matrix; full bi-quadratic occurs one grid-spacing
c                     inside the edge).
c               0 : bi-quadratic interp, Zion = (<z^2)^0.5, no derivatives.
c              -1 : use the Potekhin-website formulae, Zion = (<z^2)^0.5, with
c                     derivatives [uses linear interpolation in log(Zion)];
c                     extrapolate linearly using slope at edge of matrix.
c                     (This cubic interpolation from the Potekhin-website file
c                     'condint.f' is slower than bi-quadratic interpolation,
c                     and may be slightly noisier when using single precision
c                     real variables, but yields similar results).
c              -2 : bi-quadratic interp, Zion = <z>, with derivatives;
c                     NOTE:  Zion(linear) = <z> = FMUEINV / FMUAINV .
c              -3 : bi-quadratic interp, Zion = <z>, no derivatives.
c              -4 : Potekhin-website formulae, Zion = <z>, with derivatives.
c             For the (OLD) H&L ('Condopac') case:
c               1 : combine as necessary, with derivatives: use "H&L" at lower
c                     density, "Itoh" at higher density, with switchover region
c               0 : combine as necessary (no derivatives).
c              -1 : get "Itoh" conductive opacities only (no derivatives)
c              -2 : get possibly-modified "H&L" opacities only (no derivatives)
c              -3 : get "Itoh" conductive opacities only (with derivatives)
c              -4 : get possibly-modified "H&L" only (with derivatives)
c          NOTE: "H&L" is W. B. Hubbard & M. Lampe 1969, ApJS 163, 297; "Itoh"
c          is N. Itoh, S. Mitake, H. Iyetomi, & S. Ichimaru 1983, ApJ 273, 774
c          plus S. Mitake, S. Ichimaru, & N. Itoh 1984, ApJ 277, 375.
c    FLKC = (real) variable returning Log(Kappa_cond), equivalent to OPACT
c    FLKCT = (real) variable returning dLog(kappa_cond)/dLog(T) at constant
c              density, equivalent to DOPACTD (note that a value of 0.0 will be
c              returned if IDER indicates derivatives should not be calculated)
c    FLKCRO = (real) variable returning dLog(kappa_cond)/dLog(RHO) at constant
c               temperature, equivalent to DOPACR
c    FKCEDGE = (real) variable returning the edge factor, equivalent to FEDGE
c                or FTREDGE (note that conductive opacities have no metallicity
c                restrictions); but a negative value is returned for regions
c                more than one grid-spacing off the edge of the matrix, and a
c                value of -99999.0 is returned if conductive opacities are not
c                available.
c    FKCOK = (real) variable returning a somewhat less restrictive edge factor,
c              which is a better indicator of whether the returned conductive
c              opacity is good enough to combine with (or extend) the radiative
c              OPAL opacity.
c
c
c*** KAP_COND_POT( FLRO, FLT, ZION, IDER, FLKC, FLKCT, FLKCRO, FKCEDGE, FKCOK )
c    --------------------------------------------------------------------------
c  This subroutine calculates and returns the Potekhin et al. (2006) conductive
c  opacities (if they were not read in, it returns, indicating out-of-range).
c
c    FLRO = log(RHO) = SLR + 3.0 * SLT      (density, logarithm to the base 10)
c    FLT = log(T) = SLT + 6.0           (temperature, logarithm to the base 10)
c    ZION = Zion, the mean ionic charge (the user must calculate this for their
c             mixture, e.g. the rms nuclear charge weighted by number density).
c             It is a fatal error if Zion < 0.1 or Zion > 130. 
c    IDER = flag controlling which conductive opacities are returned:
c              1 : bi-quadratic interpolation, with derivatives; switched over
c                    to linear extrapolation at matrix edge.
c              0 : bi-quadratic interpolation, no derivatives.
c             -1 : use the Potekhin-website formulae, with derivatives [linear
c                    interpolation in log(Zion), cubic interpolation in logT,
c                    logRHO]; linear extrapolation via slope at matrix edge.
c    FLKC, FLKCT, FLKCRO, FKCEDGE, FKCOK : (real) variables returning values as
c                                            in KAPCOND above.
c
c
c*** SET_COND_USE( KCOND, KREPLACE_ITOH )  This subroutine allows the user to
c    ------------------------------------  control the way conductive opacities
c  will be handled; it may be called at any time to change this behavior:
c
c    KCOND = integer input flag controlling handling of conductive opacities:
c              1 : (DEFAULT): if a conductive-opacity file has been read in,
c                    then the conductive opacity will be combined with the
c                    OPAL opacity to yield the overall opacity value when OPAL
c                    opacity routines are called (and also used to extend the
c                    OPAL opacity to higher density).
c              0 : even if a conductive-opacity file has been read in, the
c                    conductive opacities will be ignored when computing OPAL
c                    opacities (i.e., the conductive opacities can only be
c                    accessed by the subroutine KAPCOND described above).
c             -9 : reset to the default value of 1.
c            -99 : leave the present stored value of this flag unchanged.
c    KREPLACE_ITOH = integer input flag controlling how conductive opacities
c                      are calculated:
c                       99 : (DEFAULT) use the most recent/best conductive
c                              opacities available.
c                       -9 : reset to the default value of 99.
c                      -99 : leave the present stored value unchanged.
c                      For Potekhin 2006:
c                        2 : use bi-quadratic interpolation in logRHO, logT,
c                              and log(Zion), where Zion = (<z^2>)^0.5 (rms).
c                        1 : use the formulae from the website: i.e., cubic
c                              interpolation in logRHO, linear interpolation in
c                              log(Zion), and cubic interpolation in logT,
c                              where Zion = (<z^2>)^0.5 (rms).
c                        0 : use bi-quadratic interpolation in logRHO, logT,
c                              and log(Zion), where Zion = <z> (linear mean).
c                       -1 : use the formulae from the website: i.e., cubic
c                              interpolation in logRHO, linear interpolation in
c                              log(Zion), and cubic interpolation in logT,
c                              where Zion = <z> (linear mean).
c                      For H&L 1969:
c                        2 : reserved (at present, means the same as 0).
c                        1 : reserved (at present, means the same as 0).
c                        0 : use the 1983/1984 'Itoh' conductive opacities to
c                              modify and extend the 'H&L' ones.
c                       -1 : use only these 'H&L' conductive opacities, not the
c                              1983/1984 'Itoh' ones.
c
c
c*** ASK_COND_USE( KCOND, KCOND_AVAIL, KREPLACE_ITOH )  This returns the values
c    -------------------------------------------------  of these integer flags
c  that control the use of conductive opacities (see SET_COND_USE above):
c
c    KCOND = integer variable returning the value of KCOND as in SET_COND_USE.
c    KCOND_AVAIL = integer variable returning returning a flag value telling
c                    whether the conductive opacities are actually available:
c                     0 : not available (NO conductive opacities have ever
c                           been read in).
c                     1 : H&L 1969 conductive opacities have been read in.
c                     2 : Potekhin 2006 conductive opacities have been read in.
c    KREPLACE_ITOH = integer variable returning the value of KREPLACE_ITOH as
c                      in SET_COND_USE above.
c
c  [NOTE: if KCOND_AVAIL > 0, then the subroutine KAPCOND can be used to get
c  conductive opacities, and if KCOND > 0 then these conductive opacities will
c  be used to extend the OPAL opacities to high RHO.]
c
c
c
c         =============================================================
c         Other subroutines that may be used when reading in opacities:
c         =============================================================
c
c
c*** SET_ALEX_FILE( CFILEALEX, I_FULL_PATH )  This subroutine allows the user
c    ---------------------------------------  to specify a molecular opacity
c  file whose name has been changed, or which is in a different directory.
c----NOTE: ANY DIRECTORY that you specified via SET_MOL_DIR will be DISCARDED.
c
c    CFILEALEX = character variable or string constant giving a non-default
c                    name for the molecular opacity file(s); NOTE that if the
c                    input string  CFILEALEX  ends with a slash ('/'),
c                    then it will be treated as a directory (or subdirectory)
c                    specification and the default filename will be appended.
c                    For Ferguson et al. (2005) molecular opacities, the
c                    (optional) directory specification may be followed by a
c                    filename beginning-part (as in SET_FERG_USER just below).
c    I_FULL_PATH = integer flag indicating how this should be interpreted:
c                    0 : (DEFAULT): look for molecular opacity file(s) in the
c                          same directory as the OPAL opacity files (or a
c                          subdirectory thereof, if CFILEALEX contains a
c                          subdirectory specification).
c                    1 : just look for file(s) called (or whose names start
c                          with) CFILEALEX (i.e., either the file(s) are in
c                          the local directory, or else the string CFILEALEX
c                          includes any required directory pathname).
c
c
c*** SET_FERG_USER( CBEG_FERG )  This subroutine allows the user to set the
c    --------------------------  beginning-part of the names for a non-default
c  set of the Ferguson et al. (2005) molecular opacities:
c
c    CBEG_FERG = character variable or string constant giving the beginning of
c                  the file names, including at the end any dot ('.') that
c                  separates beginning part from the X-value in the filename
c                  (for the  default mixes,  CBEG_FERG  would be  'g'  'g98.'
c                  'l03.'  'ags04.'  's92.'  's92ae.'  'gs98-.2.'  'gs98+.2.'
c                  'gs98+.4.'  'gs98+.6.'  or  'gs98+.8.'  for GN93, GS98, L03,
c                  AGS04, S92, S92AE, GS98-.2, GS98+.2, GS98+.4, GS98+.6, or
c                  GS98+.8 mixes, respectively --- note that the GN93 mix is
c                  the only one of these that would not have the separating dot
c                  '.' at the end of the CBEG_FERG value).
c                [Note that this mix-specification may optionally be preceded
c                  by a subdirectory-specification, e.g., 'f05_gs98/g98.']
c
c
c*** ASK_FERG_USER( CBEG_FERG )  This subroutine returns the value stored by
c    --------------------------  calling SET_FERG_USER as described just above.
c
c    CBEG_FERG = character variable, to return the file-name beginning.
c
c
c*** SET_FERG_ACC( IACC )  This subroutine allows one to change the accuracy
c    --------------------  with which the Ferguson et al. (2005) molecular
c  opacities are interpolated (YOU SHOULD NOT DO SO):
c
c    IACC = (integer) flag value controlling the accuracy:
c             1 : (DEFAULT): when there is a large opacity jump between two
c                   adjacent grid-points at low temperature (logT < 3.48),
c                   avoid the large overshoot that would result just outside
c                   these grid-points from the usual biquadratic interpolation.
c             0 : (NOT RECOMMENDED!): just use usual biquadratic interpolation,
c                   which yields somewhat faster computations at logT < 3.48,
c                   but which can lead to errors of order a factor of 2, or
c                   even occasionally of more than an order of magnitude.
c
c
c*** ASK_FERG_ACC( IACC )  This subroutine returns the value of IACC presently
c    --------------------  in use, as per the subroutine SET_FERG_ACC above.
c
c    IACC = integer variable to return the value of the flag IACC.
c
c
c*** READ_BEST_MOL( IU, I_MOL, CF_HZ, OFEBRACK )  If I_MOL is non-zero, this
c    -------------------------------------------  subroutine tries to read the
c  molecular opacities that best match the OPAL opacities specified by CF_HZ
c  and OFEBRACK (see subroutine READ_EXTENDED_OPAC further above):
c
c    IU, I_MOL, CF_HZ, OFEBRACK : same as in READ_EXTENDED_OPAC further above.
c
c
c*** READFERG( IU )  This subroutine reads in the default set of Ferguson et
c    --------------  al. (2005) molecular opacities.  Ths subroutine just calls
c  the subroutine READ_ADD_FERG( IU, 0.0, 1.0, 0 ) below:
c
c    IU = (integer) Fortran unit number to use; a value of 5 or of 6 will be
c           reset to 7, and a negative value means "use the default of 23 or
c           the previous specified Fortran unit".
c
c
c*** ADDFILE_FERG( IU, F_STO, F_READ, CFILEFERG, I_FULL_PATH )  This subroutine
c    ---------------------------------------------------------  reads in a set
c  of Ferguson et al. (2005) molecular opacities, as specified by the user,
c  optionally combining them with a previously-input set (it is a fatal error
c  if the specified Ferguson opacity files are not found):
c
c    IU = (integer) Fortran unit number (as in READFERG above).
c    F_STO = (real) value by which to multiply already-stored logKappa values,
c              before adding the logKappa values newly read in; use F_STO = 0.0
c              to just read in a new set of opacities (if no Ferguson molecular
c              opacities have been read in previously, then the input value of
c              F_STO is ignored, and a value of 0.0 is used).
c    F_READ = (real) value by which to multiply the logKappa values read in
c                 from the specified files; typically, F_READ = 1.0 is combined
c                 with F_STO = 0.0 to just read in a new set of opacities (a
c                 value of F_READ = 0.0 returns without reading anything).
c    CFILEFERG = character variable or string constant giving the beginning of
c                    the Ferguson et al. (2005) molecular opacity filenames (as
c                    in SET_ALEX_FILE or SET_FERG_USER above); this specifies
c                    which set to use.
c    I_FULL_PATH = integer flag indicating how this should be interpreted (as
c                    in SET_ALEX_FILE above):
c                    0 : (DEFAULT): look for molecular opacity file(s) in the
c                          same directory as the OPAL opacity files (or a
c                          subdirectory thereof, if CFILEFERG contains a
c                          subdirectory specification).
c                    1 : just look for files whose names start with CFILEFERG
c                          (i.e., either the files are in the local directory,
c                          or else the string CFILEFERG includes any required
c                          directory pathname).
c
c
c*** READ_ADD_FERG( IU, F_STO, F_READ, KTYPE_FERG )  This subroutine reads in
c    ----------------------------------------------  a set of either default or
c  non-default Ferguson et al. (2005) molecular opacities, as specified by the
c  user, optionally combining them with a previously-input set (it is a fatal
c  error if no Ferguson opacity files are found):
c
c    IU, F_STO, F_READ = as in subroutine ADDFILE_FERG just above.
c    KTYPE_FERG = flag indicating which molecular opacities should be read in:
c                   0 : look for the first available set of Ferguson opacities,
c                         in the order 99,1,5,4,3,2,6,7,8,... of cases below:
c                   1 : read the Ferguson mix that was specified previously by
c                         a call to SET_ALEX_FILE or ADDFILE_FERG (see above).
c                   2 : read the GN93 Ferguson mix 'g' --- if this is not found
c                         in the directory specified by SET_OPAL_DIR above (or
c                         by SET_ALEX_FILE above), look in the subdirectory
c                         'f05_g93/' as well.
c                   3 : read the GS98 Ferguson mix 'g98.' (also look in the
c                         subdirectory 'f05_gs98/')
c                   4 : read the L03 Ferguson mix 'l03.' (also look in the
c                         subdirectory 'f05_l03/')
c                   5 : read the AGS04 Ferguson mix 'ags04.' (also look in the
c                         subdirectory 'f05_ags04/')
c                   6 : read the S92 Ferguson mix 's92.' (also look in the
c                         subdirectory 'f05_s92/')
c                   7 : read the S92AE Ferguson mix 's92ae.' (also look in the
c                         subdirectory 'f05_s92ae/')
c                   8 : read the GS98-.2 Ferguson mix 'gs98-.2.' (also look in
c                         the subdirectory 'f05_gs98-.2/')
c                   9 : read the GS98+.2 Ferguson mix 'gs98+.2.' (also look in
c                         the subdirectory 'f05_gs98+.2/')
c                  10 : read the GS98+.4 Ferguson mix 'gs98+.4.' (also look in
c                         the subdirectory 'f05_gs98+.4/')
c                  11 : read the GS98+.6 Ferguson mix 'gs98+.6.' (also look in
c                         the subdirectory 'f05_gs98+.6/')
c                  12 : read the GS98+.8 Ferguson mix 'gs98+.8.' (also look in
c                         the subdirectory 'f05_gs98+.8/')
c                  99 : (actually, any value larger than 12): read the Ferguson
c                         mix specified previously by a call to SET_FERG_USER.
c                  -1 to -99 : first try the case  abs(KTYPE_FERG)  ; if it is
c                                not found, behave as if case 0 was specified.
c
c
c*** READALEX( IU )  This subroutine just reads in the file 'Alexopac' (with
c    --------------  Alexander & Ferguson 1994 molecular opacities), using the
c  Fortran unit IU (provided that this file has not already been read in).
c
c
c*** SET_COND_FILE( CFILECOND, I_FULL_PATH )  This subroutine allows the user
c    ---------------------------------------  to specify a which conductive
c  opacity file should be read in, and/or a file whose name has been changed,
c  or which is in a different directory.
c----NOTE: ANY DIRECTORY that you specified via SET_COND_DIR will be DISCARDED.
c----NOTE: Calling this subroutine SET_COND_FILE causes any previously-stored
c             conductive opacities to be DISCARDED at once.
c
c    CFILECOND = character variable or string constant giving the revised name
c    I_FULL_PATH = integer flag indicating how this should be interpreted:
c                    0 : (DEFAULT): look in same directory as for OPAL files.
c                    1 : just look for a file called CFILECOND.
c
c
c*** SET_COND_INFLAGS( KCOND_FIX, KCOND_GAP, KCOND_HAVE )  This subroutine sets
c    ----------------------------------------------------  flags controlling
c  how the 'H&L' conductive opacity tables are modified when they are read in
c  (this will have an effect only if called BEFORE you read in the opacities):
c
c    KCOND_FIX = integer input flag controlling an error-fix:
c                  1 : (DEFAULT): remove an anomalously low Hydrogen conductive
c                        opacity value (at logT = 5.4, logRHO = -0.5).
c                  0 : do not do this (NOT RECOMMENDED).
c                 -9 : reset to the default value of 1.
c                -99 : leave the present stored value unchanged.
c    KCOND_GAP = integer input flag controlling the "gap" in the 'H&L' tables,
c                  i.e., the density region where they do not extend to such
c                  low temperatures as they do at higher or lower densities:
c                    1 : (DEFAULT): high-density 'Itoh' conductive opacities
c                          are used in this "gap" to improve the 'H&L' opacity
c                          there (beyond the edge of the 'H&L' tables) in order
c                          to improve the H&L-to-Itoh switchover at increasing
c                          density and low temperature (note that no input H&L
c                          values are modified, only the extrapolation region).
c                    0 : this is not done: H&L tables are just extrapolated.
c                   -9 : reset to the default value of 1.
c                  -99 : leave the present stored value unchanged.
c    KCOND_HAVE = integer input flag controlling whether the file 'Condopac'
c                   (or 'condall06.d') will be read in again:
c                     1 : (DEFAULT): it will NOT be read in again (unless it
c                           has never been read in at all), even if you call
c                           the subroutine READCOND a second time, unless you
c                           change the filename by calling SET_COND_FILE.
c                     0 : re-read the file 'Condopac' the next time you call
c                           the subroutine READCOND.
c                   -9 : if and only if you have changed the stored value(s) of
c                          KCOND_FIX or KCOND_GAP, re-read the file 'Condopac'
c                          the next time you call the subroutine READCOND.
c                  -99 : (equivalent to specifying the default value of 1).
c
c
c*** ASK_COND_INFLAGS( KC_FIX, KC_GAP, KC_FIX_N, KC_GAP_N )  This subroutine
c    ------------------------------------------------------  returns integer
c  flag values (as may be set by the subroutine SET_COND_INFLAGS above):
c
c    KC_FIX = integer variable returning the value of KCOND_FIX that was used
c               the last time 'Condopac' was read in.
c    KC_GAP = integer variable returning the value of KCOND_GAP that was used
c               the last time 'Condopac' was read in.
c    KC_FIX_N = integer variable returning the value of KCOND_FIX that will be
c                 used the NEXT time 'Condopac' is read in.
c    KC_GAP_N = integer variable returning the value of KCOND_GAP that will be
c                 used the NEXT time 'Condopac' is read in.
c
c
c*** READ_COND_POT( IU )  This subroutine just reads in the Potekhin 2006
c    -------------------  conductive opacity file 'condall06.d', using Fortran
c  unit IU (provided that it has not already been read in).
c
c
c*** READCOND( IU )  This subroutine just reads in either the Potekhin 2006
c    --------------  conductive opacity file 'condall06.d' or the older H&L
c  file 'Condopac', using Fortran unit IU (provided that conductive opacities
c  have not already been read in).
c
c
c*** SET_OFE_FILE( cfileofe )  The input character variable  cfileofe  can be
c    ------------------------  used to set a user-specified filename containing
c  non-CO-rich opacities with [O/Fe] > 0.0, similar to 'Alrd96a2', 'C95hz', or
c  'W95hz'.  Only the filename (not the directory pathname) should be specified
c  and the length of the filename MUST NOT exceed 8 characters.  This filename
c  is only used in the case  khighz = 5, 15, 25, or 35  (see READZEXCO below).
c
c
c*** SET_ALTMIX_OFE_FILE( cfileofe )  The input character variable  cfileofe
c    -------------------------------  can be used to set a user-specified
c  filename containing non-CO-rich GS98 opacities with [O/Fe] > 0.0; the length
c  of the name is only restricted by the fact that filename plus OPAL directory
c  name cannot exceed 255 characters in total.  This filename is only used in
c  the case  khighz = -5, -15, -25, or -35  (see READZEXCO below).
c
c
c*** SET_ALTMIX_MAIN_FILE( cfile_hz )  The input character variable  cfile_hz
c    --------------------------------  can be used to replace the alternate
c  main file 'GS98hz' with a user-specified filename; this new file will be
c  assumed to have [O/Fe] = 0.0, i.e., a solar mix.  The length of the name is
c  only restricted by the fact that filename plus OPAL directory name cannot
c  exceed 255 characters in total.  This filename is used whenever khighz < 0
c  (see description in READZEXCO below); note that khighz = -2, -3, and -4
c  should NOT be used subsequently, unless this file replacing 'GS98hz' also
c  has the Grevesse & Sauval 1998 mix.
c
c
c*** SET_CNO_FILES( cf_m, cf_c, cf_o, cf_n, cf_user )  This subroutine can be
c    ------------------------------------------------  used to set the five
c  alternate opacity filenames that can be used to obtain the CNO-interpolation
c  opacity shifts (plus a user-specified case); the input character variables
c  are only restricted by the fact that filename plus OPAL directory name can't
c  exceed 255 characters in total (blank values mean "use default filenames"):
c
c    cf_m = a standard opacity file (with standard composition); the default
c             used in READZEXCO is 'GN93hz' if  khighz > 0,  or else  cfile_hz
c             (e.g., 'GS98hz': see SET_ALTMIX_MAIN_FILE above) if  khighz < 0
c    cf_c = an opacity file where most or all C (by number) has been converted
c             to N; the default filename is  cf_hz  with '.CtoN' appended
c    cf_o = an opacity file where most/all of both C and O have been converted
c             to N; the default filename is  cf_hz  with '.COtoN' appended
c    cf_n = an opacity file where all CNO has been converted to Ne; the default
c             filename is  cf_hz  with '.CNOtoNe' appended
c    cf_user = a user-specified opacity file, with a composition that can be
c                arbitrarily different from that in the file cf_hz; the default
c                filename is  cf_hz  with '.user' appended
c
c  NOTE that the first four of these files (cf_m, cf_c, cf_o, cf_n) should all
c  have the SAME number fractions for the elements heavier than Ne (only C,N,O,
c  Ne should be interconverted in these CNO-interpolation files).
c
c  Note that as long as the files cf_m, cf_c, cf_o, and cf_n have compositions
c  that are not linearly dependent (or close to it) in the 3-dimensional space
c  of interconversion of C, N, O, and Ne, the CNO-interpolation should still
c  work correctly.  However, it has been tested only for the specific case
c  described above.
c
c
c*** SET_CNO_EXT( ie, ce_hz, ce_c, ce_o, ce_n, ce_u )  This subroutine can
c    ------------------------------------------------  be used to change the
c  default extensions for the CNO-interpolation files (which are used to decide
c  on the default CNO-filenames); this can be used as an alternative to calling
c  the subroutine SET_CNO_FILES.  As noted above, these default extensions are
c  ' ' , '.CtoN' , '.COtoN' , '.CNOtoNe' , '.user'  respectively.  Calling this
c  subroutine sets these default extensions to the values of the character
c  variables  ce_hz, ce_c, ce_o, ce_n, ce_u  respectively.  The integer  ie
c  controls the meaning of a blank input character value:
c    ie = 0 : in all cases, a blank input character value means do not change
c               the corresponding default extension (UNLESS YOU HAVE SOME VERY
c               PECULIAR NAMING CONVENTIONS FOR CNO FILES, THIS IS THE ONLY
c               CASE YOU ARE LIKELY TO NEED)
c    ie = 1 : if  ce_hz  is blank, reset the corresponding extension to blank
c               (i.e., the default filename remains  'GN93hz'  or  cfile_hz);
c               but if any of the other input character values are blank, do
c               not change these other corresponding default extension
c    ie = 2 : if  ce_c  is blank, reset the corresponding extension to blank
c    ie = 3 : if  ce_o  is blank, reset the corresponding extension to blank
c    ie = 4 : if  ce_n  is blank, reset the corresponding extension to blank
c    ie = 5 : if  ce_u  is blank, reset the corresponding extension to blank
c    ie = 6 thru 10 : same as ie = 1 thru 5, respectively
c  Note that an extension longer than 80 characters cannot be accommodated.
c
c
c*** SET_METEOR_MIX_FILE( cfilemet )  The input character variable  cfilemet
c    -------------------------------  can be used to set a user-specified
c  filename containing a meteoritic mixture.  This file is used ONLY to set
c  the components of Z for a meteoritic mixture, which are available to the
c  user but are not used in calculating any opacities.
c
c
c*** ASK_OPAL_FILE_USED( ITYPE, CF_USED )  This subroutine returns the name of
c    ------------------------------------  the specified type of opacity file 
c that was (or will be) used to read in the opacities:
c
c    ITYPE = integer input flag controlling which file name is returned:
c              -1 : the name of the OPAL directory CDIRIN.
c               0 : meteoritic-mix file CFILEMET (this file may not exist).
c               1 : the main mix file CF_HZ.
c               2 : molecular opacities file CFILEALEX, including directory.
c               3 : conductive opacities file CFILECOND, including directory.
c               4 : the file 'GN93hz' (needed to correct Gz???x?? files).
c               5 : the non-zero-[O/Fe] file CF_OFE.
c               6 : the CNO-interpolation main mix file CF_M.
c               7 : the CNO-interpolation C --> N file CF_C.
c               8 : the CNO-interpolation CO --> N file CF_O.
c               9 : the CNO-interpolation CNO --> Ne file CF_N.
c              10 : the user-mix file CF_USER.
c    CF_USED = character variable returning the filename specified by ITYPE.
c
c
c*** ASK_KHIGHZ_OFE( KHIGHZ_USED, OFEBRACK_USED )  This subroutine returns the
c    --------------------------------------------  values that were used when
c  the subroutine READZEXCO was called to read in the opacities (directly or
c  via READ_BASIC_OPAL_OPAC or READ_EXTENDED OPAC):
c
c    KHIGHZ_USED = integer variable returning the value of KHIGHZ (see below).
c    OFEBRACK_USED = real variable returning the value of [O/Fe] that was used.
c
c
c*** READZEXCO( Nzin, Zlo, Z, Zhi, khighz, iulow, ofebrack )  This subroutine
c    -------------------------------------------------------  is used to read
c  in the OPAL opacity files, allowing the user to control whether and how
c  opacities will subsequently be interpolated in Z.  Note that a new set of
c  opacities (at a new Z-range or Z-value) can be read in at any time.
c
c  The controlling input variables are:
c
c    Nzin      INTEGER: the number of metallicity values Z_i to be stored,
c                for subsequent Z-interpolation when OPAL or OPAC is called;
c                this is discussed just below.  Nzin = -9 means "use the widest
c                available Z-range around the input Z-value".
c    Zlo       SINGLE-PRECISION REAL: the lowest metallicity value that will
c                be required; this is discussed just below.
c    Z         SINGLE-PRECISION REAL: the "typical" or central metallicity
c                value; this is discussed just below.
c    Zhi       SINGLE-PRECISION REAL: the highest metallicity value that will
c                be required; this is discussed just below.
c    khighz    INTEGER: controls the use of the C=O=0.0 opacity file 'GN93hz'
c                (and/or its equivalents with newer mixes, such as 'GS98hz' and
c                'AGS04hz'), and of the similar files having [O/Fe] > 0.0:
c                 khighz = 0: use of the file 'GN93hz' is prevented; only for
c                              X < 0.75 is accurate X-interpolation available.
c                 khighz = 1: the file 'GN93hz' is used to obtain opacities for
c                              the C=O=0.0 mixes (i.e., opacities with better
c                              Z-interpolation), including the added X-values
c                              X={0.2,0.5,0.8,0.9,0.95,1-Z} (i.e., allowing
c                              accurate X-interpolation up to X = 1-Z); for
c                              the mixes with C+O > 0.0, corresponding opacity
c                              shifts are applied, for consistency.
c                 khighz = 2: file 'Alrd96a2' with [O/Fe] = 0.3 \  is used in
c                 khighz = 3: file 'C95hz' with [O/Fe] = 0.4     } addition to
c                 khighz = 4: file 'W95hz' with [O/Fe] = 0.5    /  'GN93hz',
c                              if READZEXCO was called with a non-zero value of
c                              ofebrack, in order to interpolate in the excess
c                              oxygen/alpha-element enrichment [O/Fe].
c                 khighz = 5: the name of a file with non-zero [O/Fe] must have
c                              been set already, by calling the subroutine
c                              SET_OFE_FILE described below; it will be used
c                              instead of 'Alrd96a2', 'C95hz', or 'W95hz' when
c                              interpolating in [O/Fe] (its [O/Fe] value will
c                              be computed when it is read in; if it actually
c                              has [O/Fe] = 0.0, the resulting behavior is not
c                              defined and will surely be erroneous).
c                 khighz = -1 thru -5: similar to khighz = 1 thru 5, except
c                              that a different set of OPAL opacity files is
c                              used, defining a different set of heavy-element
c                              abundances to comprise the solar metallicity Z.
c                              THE OLD FILE 'GN93hz' IS STILL REQUIRED AS WELL,
c                              but the opacities now stored are those from the
c                              new file with the same format (called 'GS98hz',
c                              by default), and this is the composition that
c                              is assigned a value of [O/Fe] = 0.0; khighz = -2
c                              thru -5 likewise implies the use of files with
c                              [O/Fe] > 0.0 relative to the mix in 'GS98hz': by
c                              default 'GS98hz_OFe.3_Alrd96a2' at [O/Fe] = 0.3,
c                              'GS98hz_OFe.4_C95' at 0.4, 'GS98hz_OFe.5_W95'
c                              at 0.5, or user-defined for khighz = -5 via the
c                              subroutine SET_ALTMIX_OFE_FILE (see below).  The
c                              main alternate solar-composition [O/Fe]=0.0 file
c                              name can be changed from 'GS98hz' by calling the
c                              subroutine SET_ALTMIX_MAIN_FILE (see below); if
c                              this is done, khighz = -2 thru -4 should not be
c                              used subsequently unless the replacement main
c                              file still uses the Grevesse & Sauval 1998 mix;
c                              rather, if one wishes opacities with a non-zero
c                              [O/Fe] value, one should do something such as:
c                               call set_altmix_main_file( 'AGS04hz' )
c                               call set_altmix_ofe_file( 'AGS04hz_OFe.5_W95' )
c                              and then use khighz = -5.
c                 khighz = -11 thru -15,  OR
c                          11 thru 15: same as khighz = -1 thru -5 OR 1 thru 5,
c                              except that CNO-interpolation opacity files are
c                              read in (if possible: uses the filenames "CF_HZ,
c                              CF_C, CF_O, CF_N" that can be set by calling
c                              SET_CNO_FILES: see below)
c                 khighz = -21 thru -25,  OR
c                          21 thru 25: same as khighz = -1 thru -5 OR 1 thru 5,
c                              except that a user-specified (OPAL) opacity
c                              interpolation file is read in (if possible: uses
c                              the filenames "CF_HZ, CF_U" that can be set by
c                              calling SET_CNO_FILES: see below)
c                 khighz = -31 thru -35,  OR
c                          31 thru 35: same as khighz = -1 thru -5 OR 1 thru 5,
c                              except that BOTH the CNO- and user-specified
c                              opacity interpolation files are read in (if
c                              possible)
c    iulow     INTEGER: the beginning Fortran unit number for reading opacity
c                files; Fortran units  iulow  through  iulow + 3  may be used.
c                Zero or negative iulow values mean "use previous (or default)
c                value", where the default value is iulow = 23.  A fatal error
c                will result if iulow < 7 or iulow > 96 (unless you have set
c                the error level to 0, in which case these values are ignored).
c                (Note: unless the user explicitly calls READZEXCO, READEXCO,
c                READCO, or READ_OPAL_DUMP, the default-setup call to READZEXCO
c                in OPAL will be executed, yielding the default iulow of 23).
c    ofebrack  SINGLE-PRECISION REAL: the value of [O/Fe], the logarithmic
c                oxygen (or alpha-element) enhancement factor, relative to the
c                Sun:  ofebrack = log10{ (O_mix/Fe_mix) / (O_sun/Fe_sun) } ,
c                where O_mix, Fe_mix, O_sun, and Fe_sun are number densities.
c                If  khighz = 0, 1, or -1, then ofebrack is ignored; otherwise,
c                READZEXCO interpolates (or extrapolates) log(Kappa) linearly
c                between mix 1 (or -1) and mix  mod(khighz,10) , interpolation
c                factors being such as to yield the desired [O/Fe] by combining
c                these mixes.  Note: 'GN93hz' has [O/Fe] = 0.0 by definition,
c                'Alrd96a2' has [O/Fe] = 0.3, 'C95hz' has [O/Fe] = 0.4, and
c                'W95hz' has [O/Fe] = 0.5, but they have different patterns of
c                enhancements for elements other than oxygen; their elemental
c                abundances and the corresponding opacity shifts are discussed
c                further below.
c
c  ----------------------------------------------------------------------------
c  Discussion of  Nzin, Zlo, Z, Zhi  in calling the above subroutine READZEXCO:
c  ----------------------------------------------------------------------------
c
c  Z-interpolation of opacity is actually carried out in terms of log(Z+0.001).
c  The maximum number of z-values that can be stored (to interpolate among) is
c  given by the value of the constant  NZ  in the parameter statements that
c  begin as  "parameter ( nz=" .  The maximum sensible value is NZ = 14, which
c  requires about 22.7 Mb of opacity matrix storage space.  Other reasonable
c  values include NZ = 8 (13.0 Mb) and NZ = 5 (8.1 Mb); a value of NZ = 3 (4.9
c  Mb) still allows quadratic Z-interpolation, while NZ = 2 (3.2 Mb) allows
c  only linear interpolation in log(Z+0.001); for NZ = 1 (1.6 Mb), the program
c  behaves much the same as the earlier version of MAY 28, 1999 (or as if the
c  subroutines READCO or READEXCO were used instead of READZEXCO).
c
c  If you have reduced the error-checking level to 0 (using SET_ERR_CHECK),
c  then the input value of  Nzin  will be decreased if necessary so that it
c  does not exceed  NZ , the maximum available number of Z-storage values;
c  otherwise, a value of  Nzin > NZ  or of  Nzin < 1  is a fatal error, EXCEPT
c  THAT  Nzin = -9  means "use maximum possible value, i.e., as if Nzin = NZ".
c  If necessary, the subroutine ASK_Z_LIMITS can be called to check the value
c  of this hard-wired limit  NZ  , or the subroutine ASK_Z_USE can be called
c  after READZEXCO to check the number of Z-values actually used  (see below).
c
c  Values of  Zlo, Z, Zhi  that are within 1.E-6 of one of the file z-values
c  { 0.0, 0.0001, 0.0003, 0.001, 0.002, 0.004, 0.01, 0.02, 0.03, 0.04, 0.05,
c  0.06, 0.08, 0.1 } are generally reset to be exactly equal to that value
c  (except that only the range [ -1.E-6 , 1.E-8 ] is reset to be exactly zero).
c  Any value of  Zlo, Z, or Zhi  greater than 0.1 is always a fatal error.
c
c  Significantly negative Z-values (below -1.E-6) mean "use default values":
c  - if all three of  Zlo, Z, Zhi  are negative, then  Z  is reset to 0.02;
c  - if only  Z  is negative, then it is reset to lie between  Zlo  and  Zhi ;
c  - if  Zlo  and/or  Zhi  is negative, then the negative value(s) will be
c     reset to "reasonable" values, according to the values of Nzin and Z.
c
c  If  Nzin = 2 , then the stored z-values are given by the input values of
c  Zlo  and  Zhi ; if both of these are negative, then a range +/- 10% in Z is
c  used; if only one of them is negative, a total range of 20% in Z is used, or
c  more if the remaining interval  [Zlo,Z]  or  [Z,Zhi]  is larger than this.
c  The minimum allowed range is 1% in Z, or delta-Z = 1.E-5 for small Z values;
c  this is a fatal error, unless you have reduced the error-checking level
c  to 0, in which case the program quietly uses this lower limit.  Likewise
c  too large a range:  Zlo < min{ 0.6 * Zhi , Zhi - 0.0002 }  is a fatal error,
c  unless you have reduced the error-checking level to 0, in which case the
c  ONLY UPPER LIMIT on the linear Z-interpolation range is that it must lie
c  within [0.0,0.1]; BEWARE that large ranges yield inaccurate interpolation.
c
c  If  Nzin > 2 , then from the set of eight "largest-allowed-spacing" Z-values
c  { z1=0.0, z2=0.001, z3=0.004, z4=0.01, z5=0.02, z6=0.03, z7=0.05, z8=0.1 },
c  choose the largest z_J and the smallest z_K such that z_J is no greater than
c  Zlo and z_K is no less than Zhi; it is then a fatal error if  Nzin < K - J ,
c  i.e., if the Z-range is too large for the given value of Nzin (unless of
c  course you have reduced the error-checking level to 0, in which case
c  arbitarily large ranges are accepted: BEWARE!).  Also...
c
c  If  Nzin > 2 , then:  if a set of  Nzin  adjacent file z-values from the set
c  { 0.0, 0.0001, 0.0003, 0.001, 0.002, 0.004, 0.01, 0.02, 0.03, 0.04, 0.05,
c  0.06, 0.08, 0.1 } encompasses the range  [Zlo,Z,Zhi] , then such a set of
c  Nzin  z-values is used (as far as possible, it will be centered on  Z ): for
c  example, for  Nzin = 3 ,  input Z-values [Zlo,Z,Zhi] = [0.01,0.02,0.03] or
c  [0.017,0.018,0.019] or [0.022,0.022,0.024] or [0.019,0.028,0.029] all yield
c  { 0.02, 0.03, 0.04 }, while [0.021,0.028,0.029] yields { 0.02, 0.03, 0.04 }.
c
c  If  Nzin = 3  and no set of 3 of the above file z-values will work, then the
c  actual input values are used (except that, if the logarithmic interval from
c  Zlo to Z is sufficiently different from that from Z to Zhi, the value of Z
c  is reset to the logarithmic midpoint of Zlo and Zhi): for example, the input
c  Z-value set [Zlo,Z,Zhi] = [0.012,0.024,0.04] yields { 0.012, 0.024, 0.04 },
c  while [0.012,0.015,0.04] yields { 0.012, 0.02208679, 0.04 }.
c
c  If  Nzin > 3  and no set of  Nzin  of the above file z-values will work,
c  then try whether a similar set that works can be obtained by removing (some
c  of) the z-values that are not present in the C,O-rich OPAL opacity files
c  Gz???.x?? , which are available at { 0.0, 0.001, 0.004, 0.01, 0.02, 0.03,
c  0.05, 0.1 }; if such a set is found (with somewhat larger z-intervals), then
c  it is used.  Otherwise, endpoints  Zlo  and  Zhi  are used, with remaining
c  z-values equally spaced in log(Z+0.001) between these endpoints.
c
c******* NOTE that if you have set the error-level to 0, then there is NO UPPER
c  LIMIT on the maximum allowed Z-range (except that it must lie in the range
c  [0.0,0.1] where OPAL opacities are available), and thus QUITE INACCURATE
c  Z-interpolation will occur if the input Z-range [ Zlo , Zhi ]  is relatively
c  large and  Nzin  (or NZ) is relatively small.
c
c  One or two of the Type-1 OPAL files can be read in (as specified by  khighz
c  in your call to the opacity-reading subroutine READZEXCO).  For example,
c        call readzexco( 14, 0.0, -1.0, 0.1, 1, 23, 0.0 )
c  will read in opacities at all Z-values from 0.0 to 0.1, reading additional
c  opacities from  'GN93hz'  (due to the value of khighz=1); Fortran units 23
c  through 26 will be used for input, and the opacities will have [O/Fe]=0.0
c  (solar composition for the abundances comprising Z).  For non-CO-rich cases,
c  this allows slightly improved Z-interpolation (for Z < 0.12) and slightly
c  improved X-interpolation (for 0.03 < X < 0.75); for high hydrogen abundances
c  (X > 0.75), such as may result from diffusion (e.g., helium settling), the
c  accuracy is GREATLY IMPROVED.
c
c  NOTE that only the version  z14xcotrin21.f  allows Nzin = 14 as in the above
c  call; if one is using the less-memory-hogging version  z5xcotrin21.f  , then
c  the above call would lead to a fatal error, unless you had reduced the error
c  checking level, in which case it would lead to opacities being read in only
c  for the Z-values Z = { 0.0, 0.00217, 0.00905, 0.0309, 0.1 }, yielding MUCH
c  LESS ACCURATE Z-interpolation; USER BEWARE!!
c
c  For  z5xcotrin21.f  , only a small Z-range should be read in: for example,
c        call readzexco( 5, -1.0, 0.02, -1.0, 4, 23, 0.45 )
c  reads opacities at Z = .004, .01, .02, .03, .04, using 'GN93hz' and 'W95hz'
c  to obtain opacities at [O/Fe]=0.45 (the results are then as accurate as with
c  the version  z14xcotrin21.f  for the restricted Z-range 0.01 < Z < 0.03:
c  this is described in more detail below).
c
c  For  z1xcotrin21.f  , only a SINGLE Z-value can be read in; the opacities
c  from the files will be interpolated in Z while being read in, if necessary.
c
c  To read opacities in the widest available Z-range around some metallicity Z
c  that is compatible with accuracy, one would use Nzin = -9, e.g.,
c        call readzexco( -9, -1.0, Z, -1.0, 11, 23, 0.0 )
c  This would read opacities with  [O/Fe] = 0.0  in a range around  Z  that is
c  determined by the value of NZ in the parameter statements in this file.
c
c  NOTE that if opacities have not already been read in, then the first time
c  that an opacity-calculating subroutine is called (e.g., OPAC or OPAL), it
c  will use  "call readzexco( -9, -1.0, z, -1.0, 1, 23, 0.0 )"  to read in the
c  opacities, i.e., basic opacities for the maximum reasonable Z-range (with
c  [O/Fe] = 0.0 and no CNO-interpolation, only interpolation in "excess-C,O").
c
c
c*** READCO( Z, kallrd, khighz, iulow )              These subroutines behave
c    ----------------------------------              the same as the previous
c*** READEXCO( Z, kallrd, khighz, iulow, ofebrack )  version of MAY 28, 1999:
c    ----------------------------------------------  opacities are read in at
c  the SINGLE metallicity  Z  (interpolated among available OPAL opacity files,
c  if necessary), but subsequently opacities are available only at this single
c  metallicity, unless and until the user explicitly reads in a new set of
c  opacities via another call to READCO, READEXCO, or READZEXCO.  (For READCO,
c  any positive value of  khighz  is set to 1, and any negative value to -1 ).
c     NOTE THAT the input INTEGER  kallrd  is ignored (it is included only for
c  backward compatibility).
c
c
c  ============================================================================
c  Subroutines used to control the switchover from OPAL to molecular opacities:
c  ============================================================================
c
c
c  NOTE that the Ferguson and the Alexander switchover spcifications are
c  entirely separate: only one will take effect at any time, namely, the one
c  for which the corresponding molecular opacities have been read in.
c
c
c*** SET_LOGT_SW_FERG( FLTSW_LO, FLTSW_HI )  Set the temperature-boundaries of
c    --------------------------------------  the switchover region from OPAL to
c  Ferguson et al. (2005) molecular opacities (this subroutine can be called
c  at any time, to change the switchover temperatures):
c
c    FLTSW_LO = lowest logT of switchover region, where only Ferguson is used:
c                 -99.0 : leave current stored logT value unchanged.
c                 -50.0 : use the default value (of logT = 4.2).
c                 > -20 : use the input value FLTSW_LO, except that:
c                           it will not be lower than 3.75 (lowest T for OPAL),
c                           it will not exceed 4.45 (near highest Ferguson T).
c    FLTSW_HI = highest logT of switchover region, where only OPAL is used:
c                 -99.0 : leave current stored logT value unchanged.
c                 -50.0 : use the default value (of logT = 4.4).
c                 > -20 : use the input value FLTSW_HI, except that:
c                           it will not exceed 4.50 (highest Ferguson T),
c                           it will not be lower than 3.80 (near lowest OPAL).
c
c  Note that in no case will  FLTSW_HI - FLTSW_LO < 0.05  be allowed to occur
c  (the values will be moved further apart if this happens).
c
c
c*** ASK_LOGT_SW_FERG( FLTSW_LO, FLTSW_HI )  Return the current Ferguson logT
c    --------------------------------------  switchover values (as above).
c
c
c*** SET_LOGT_SW_ALEX( FLTSW_LO, FLTSW_HI )  Set the temperature-boundaries of
c    --------------------------------------  the switchover region from OPAL to
c  Alexander & Ferguson 1994 molecular opacities (this subroutine can be called
c  at any time, to change the switchover temperatures):
c
c    FLTSW_LO = lowest logT of switchover region, where only Alexander is used:
c                 -99.0 : leave current stored logT value unchanged.
c                 -50.0 : use the default value (of logT = 3.87).
c                 > -20 : use the input value FLTSW_LO, except that:
c                           it will not be lower than 3.75 (lowest T for OPAL),
c                           it will not exceed 4.05 (near highest Alexander T).
c    FLTSW_HI = highest logT of switchover region, where only OPAL is used:
c                 -99.0 : leave current stored logT value unchanged.
c                 -50.0 : use the default value (of logT = 3.97).
c                 > -20 : use the input value FLTSW_HI, except that:
c                           it will not exceed 4.10 (highest Alexander T),
c                           it will not be lower than 3.80 (near lowest OPAL).
c
c  Note that in no case will  FLTSW_HI - FLTSW_LO < 0.05  be allowed to occur
c  (the values will be moved further apart if this happens).
c
c
c*** ASK_LOGT_SW_ALEX( FLTSW_LO, FLTSW_HI )  Return the current Alexander logT
c    --------------------------------------  switchover values (as above).
c
c
c*** SET_ALEX_DO_RHOSW( IRHOSW )  Set the flag controlling whether there is a
c    ---------------------------  density-switchover too (in the temperature
c  region where both OPAL and Alexander 1994 opacities are available, but where
c  the OPAL opacities are available up to higher densities):
c
c  IRHOSW = input integer flag:
c             1 : (DEFAULT): use a density-switchover region too.
c             0 : do not do so.
c            -9 : use the default value of 1.
c           -99 : leave the stored value unchanged.
c
c
c*** SET_LOGRHO_SW_ALEX( FLRHOSW_LO, FLRHOSW_HI )  Set the density-boundaries
c    --------------------------------------------  of the switchover region
c  (for Alexander 1994 opacities) that is enabled/disabled by SET_ALEX_DO_RHOSW
c  above (this can be called at any time, to change the switchover densities):
c
c  FLRHOSW_LO = lowest logRHO of switchover region, where only Alexander used:
c                 -99.0 : leave current stored logRHO value unchanged.
c                 -50.0 : use the default value (of logRHO = -6.25).
c                 > -20 : use the input value FLTSW_LO, except that it will lie
c                           in the range  -14.0 < FLRHOSW_LO < -6.0  .
c  FLRHOSW_HI = highest logRHO of switchover region, where only OPAL is used:
c                 -99.0 : leave current stored logRHO value unchanged.
c                 -50.0 : use the default value (of logRHO = -5.75).
c                 > -20 : use the input value FLTSW_HI, except that it will lie
c                           in the range  -13.75 < FLRHOSW_HI < -5.75  .
c
c  Note that in no case will  FLRHOSW_HI - FLRHOSW_LO < 0.25  be allowed to
c  occur (the values will be moved further apart if this happens).
c
c
c*** ASK_LOGRHO_SW_ALEX( FLRHOSW_LO, FLRHOSW_HI )  Return current switchover
c    --------------------------------------------  logRHO values (as above).
c
c
c*** SET_LOGT_RHOSW_ALEX( FLTSW_R_LO, FLTSW_R_HI )  Set the temperature-bounds
c    ---------------------------------------------  below which the Alexander-
c  to-OPAL density-switchover described above does not take place (due to the
c  low-temperature limit of the OPAL opacities):
c
c    FLTSW_R_LO = lowest logT of switchover region, where only Alexander used:
c                   -99.0 : leave current stored logT value unchanged.
c                   -50.0 : use the default value (of logT = 3.70).
c                   > -20 : use the input value FLTSW_LO, except that:
c                             it will not be lower than 3.70 (the lowest
c                               allowed OPAL-extrapolation logT value),
c                             it will not exceed FLTSW_HI - 0.05 (see the
c                               subroutine SET_LOGT_SW_ALEX above).
c    FLTSW_R_HI = highest logT of switchover region, where only OPAL is used:
c                   -99.0 : leave current stored logT value unchanged.
c                   -50.0 : use the default value (of logT = 3.80).
c                   > -20 : use the input value FLTSW_HI, except that:
c                             it will not exceed FLTSW_HI,
c                             it will not be lower than 3.75

c  Note that in no case will  FLTSW_R_HI - FLTSW_R_LO < 0.05  be allowed to
c  occur (the values will be moved further apart if this happens).
c
c
c*** ASK_LOGT_RHOSW_ALEX( FLTSW_R_LO, FLTSW_R_HI )  Return density-switchover
c    ---------------------------------------------  logT-bounds as above.
c
c
c         ==========================================================
c         The subroutines that control the X-interpolation accuracy:
c         ==========================================================
c
c
c*** SET_XHI( kxhi )  Set a flag telling whether or not to use the additional
c    ---------------  'GN93hz' X-values for more accurate X-interpolation
c  (provided they are available, i.e., 'GN93hz' or 'GS98hz' has been read in).
c    If  kxhi = 2  , then a flag is set such that the 'GN93hz' X-values will be
c                      used whenever they are available (this is the DEFAULT
c                      case, if you never call SET_XHI).  Note that only at
c                      X > 0.03 will the 'GN93hz' X-values affect the resulting
c                      interpolated opacity values.
c    If  kxhi = 1  , then a flag is set such that the 'GN93hz' X-values will be
c                      used whenever they are available, but ONLY for values of
c                      X > 0.7 (this yields faster but slightly less accurate
c                      X-interpolation for X < 0.7, while retaining accurate
c                      opacities for large X-values up to X = 1-Z (such as may
c                      arise from diffusive processes).
c    If  kxhi = 0  , then a flag is set such that the 'GN93hz' X-values will
c                      NOT be used, even when they are available (this results
c                      in only slightly poorer X-interpolation for X < 0.75,
c                      but yields wildly incorrect opacities for very large X
c                      values, i.e., for X approaching 1-Z).
c  Note that the 'GN93hz' X-values are available for X-interpolation ONLY if
c  the 'GN93hz' file has been read in, i.e., if READZEXCO above has been called
c  with a non-zero value of  khighz  among its input parameters.  Note also
c  that, strictly, the 'GN93hz' X-values are defined only for non-CO-rich mixes
c  (C=O=0.0); but corresponding opacity shifts are applied for consistency up
c  to a CO-enhancement of C+O = 0.2, these shifts being reduced to zero as C+O
c  increases from 0.2 to 0.3 and being ignored for C+O of 0.3 or more.
c
c
c*** ASK_XHI( kxhi, kavail )  Returns INTEGER VARIABLE flags telling whether
c    -----------------------  'GN93hz' X-values will be used, and whether they
c  are actually available at the moment:
c  Returns  kxhi  value as set most recently by SET_XHI above (i.e., returns
c                         kxhi = 0, 1, or 2, with the same meaning as above);
c                         if SET_XHI was never called, then returns  kxhi = 2 .
c  Returns  kavail = 1  if the 'GN93hz' files have been read in, i.e., the
c                         'GN93hz' X-values are available, and will be used for
c                         X-interpolation if the value of  kxhi  so indicates.
c           kavail = 0  if the 'GN93hz' file has NOT (yet) been read in,
c                         i.e., the 'GN93hz' X-values are not available, and
c                         can NOT be used for X-interpolation no matter what
c                         value  kxhi  has (unless 'GN93hz' is read in later).
c
c
c      ===============================================================
c      The subroutines that control the CNO and/or user-interpolation:
c      ===============================================================
c
c
c*** SET_CNO_INTERP( kcno, kuser )  Set flags telling whether or not to use the
c    -----------------------------  CNO/user-interpolation opacity shifts; by
c  default, both are used, providing they are available (i.e., providing the
c  relevant opacity files were read in: see flag  khighz  in READZEXCO above).
c    If  kcno > 0 ,  then the CNO-interpolation opacity shifts will be used (if
c                      available); otherwise, they will be ignored
c    If  kuser > 0 ,  then the user-specified opacity shifts will be used (if
c                       available); otherwise, they will be ignored
c
c
c*** ASK_CNO_INTERP( kcno, kuser, kcno_avail, kuser_avail )  Returns INTEGER
c    ------------------------------------------------------  VARIABLE flags to
c  indicate whether CNO/user-interpolation opacity shifts will be used when
c  obtaining opacities.
c    Returns  kcno, kuser  as set by SET_CNO_INTERP above (or their default
c                            values of 1 if SET_CNO_INTERP was never called)
c    Returns  kcno_avail, kuser_avail  values of 1 if the corresponding opacity
c                                        files have been read in, or 0 if not
c
c
c         =========================================================
c         The subroutines that control the level of error-checking:
c         =========================================================
c
c
c*** SET_ERR_CHECK( LEVEL )  This subroutine sets the error-checking level to
c    ----------------------  the given (integer) input value LEVEL:
c  Level = 0 : Only minimal error checking is performed on inputs.  A Z-value
c                above 0.1 in the arguments to the opacity-reading subroutine
c                READZEXCO is a fatal error, as is an inconsistent composition
c                input to the opacity-calculating subroutines OPAC or OPAL;
c                most other problematic input is handled or accepted silently,
c                in a manner that ought to be reasonable (but no guarantees!).
c  Level = 1 : This is the DEFAULT case (which will occur if you never call the
c                subroutine SET_ERR_CHECK).  At this level, error-checking is
c                performed on the arguments of the subroutine READZEXCO (which
c                one calls to read in the opacities).  As described above in
c                the discussion of  Nzin, Zlo, Z, Zhi  , it is a fatal error
c                if  Nzin < 1 or if Nzin is too large (exceeding the available
c                number of Z-storage spaces).  It is also a fatal error if the
c                Z-range [Zlo,Zhi] is too small or too large.  At this level,
c                a warning will be issued if you call SET_ALTMIX_MAIN_FILE and
c                subsequently use khighz = -2, -3, or -4 (see above), or if any
c                filename exceeds 255 characters (or an extension exceeds 80).
c  Level = 2 : At this level of error-checking, in addition:  If the arguments
c                to OPAC or OPAL lie too far outside the opacity matrices, it
c                is a fatal error and the program halts (normally, such a case
c                would simply be signalled by a zero returned value of FEDGE).
c                Also, it is a fatal error if you call SET_ALTMIX_MAIN_FILE and
c                subsequently use khighz = -2, -3, or -4 (see above), or if any
c                filename exceeds 255 characters (or an extension exceeds 80).
c  Level = 3 : At this level of error-checking, in addition: if you have read
c                the CNO-interpolation opacity files, and you then call the
c                subroutine OPAL_X_CNO_FU with a metals-composition array xmet
c                with a size nmet other than 19 elements, it is a fatal error
c                (you would NOT usually want to use this Level = 3).
c
c
c*** ASK_ERR_CHECK( LEVEL )  This subroutine returns the error-checking flag
c    ----------------------  value LEVEL of as set by SET_ERR_CHECK above.
c
c
c            ====================================================
c            The subroutines that control matrix Z-edge handling:
c            ====================================================
c
c
c*** RESET_Z_LIMITS( vlo, dvlo, vhi, dvhi )  This subroutine can only be called
c    --------------------------------------  AFTER a set of opacities has been
c  read in (its effects are nullified during opacity input).  WITHOUT affecting
c  the stored z-values used for Z-interpolation, calling this subroutine resets
c  the range considered to be "interpolation" (which returns FZEDGE = 1.0) and
c  the allowed "extrapolation" region (where 0.0 < FZEDGE < 1.0 is returned).
c  Negative values (actually, below -1.E-6) mean "leave old value unchanged".
c  All these values should be SINGLE PRECISION REAL.
c    If  vlo   is non-negative, then this resets  Zlo = vlo .
c    If  dvlo  is non-negative, then this resets  Zlo_ex = Zlo - dvlo .
c    If  vhi   is non-negative, then this resets  Zhi = vhi .
c    If  dvhi  is non-negative, then this resets  Zhi_ex = Zhi + dvhi .
c  The values of Zlo and Zhi must not lie outside the range of stored z-values
c  used for Z-interpolation, i.e., cases  Zlo < z_low_interpolation_endpoint ,
c  Zhi > z_high_interpolation_endpoint , and  Zlo > Zhi  are prohibited.  The
c  only constraint on the "extrapolation" region is that  Zlo_ex < Zlo  and
c  Zhi_ex > Zhi  (setting  dvlo  and  dvhi  to zero allows extrapolation by
c  up to delta-Z = 1.E-6).  Note that FZEDGE is positive (and the opacity is
c  calculated) only for the range  Zlo_ex < Z < Zhi_ex .
c     NOTE that if  Zlo  and/or  Zhi  is set inside the range covered by the
c  stored z-values, the value of FZEDGE will be less than unity for Z outside
c  the range  [Zlo,Zhi] , but the actual calculation of opacity values will
c  continue to use interpolation (not extrapolation) as long as Z lies inside
c  the range of stored z-values; however, for  FZEDGE = 0.0 , the opacity will
c  NOT be calculated (even for Z still within the range of stored z-values).
c
c
c*** ASK_Z_LIMITS( nzmax, zmin, zmax )  This subroutine returns the values of
c    ---------------------------------  the hard-wired Z-interpolation limits,
c  allowing the user to check what these limiting values actually are.
c    INTEGER variable  nzmax  returns NZ: max number of interpolation Z-values.
c    SINGLE-PRECISION REAL variable  zmin  returns 0.0 (the lowest allowed Z).
c    SINGLE-PRECISION REAL variable  zmax  returns 0.1 (the highest allowed Z).
c
c
c*** ASK_Z_USE( nzuse, zlo, zmid, zhi, zloex, zhiex )  This subroutine returns
c    ------------------------------------------------  the current values of
c  the variables controlling Z-interpolation, allowing the user to check what
c  the values actually are.
c    INTEGER variable  nzuse  returns the number of stored z-values (that will
c      be used for Z-interpolation); if no opacity files have been read in yet,
c      then  nzuse = 0  is returned (and the other five variables will return
c      meaningless values).
c    SINGLE-PRECISION REAL variable  zlo  returns the boundary  Zlo  below
c      which a Z value is considered to require extrapolation; note that  Zlo
c      may lie above the lowest stored z-value, but not below it.
c    SINGLE-PRECISION REAL variable  zmid  returns the "typical" Z-value (which
c      has no real significance after the opacities have been read in).
c    SINGLE-PRECISION REAL variable  zhi  returns the boundary  Zhi  above
c      which a Z value is considered to require extrapolation; note that  Zhi
c      may lie below the highest stored z-value, but not above it.
c    SINGLE-PRECISION REAL variable  zloex  returns the boundary  Zlo_ex  at or
c      below which Z-extrapolation is considered too extreme to be carried out.
c    SINGLE-PRECISION REAL variable  zhiex  returns the boundary  Zhi_ex  at or
c      above which Z-extrapolation is considered too extreme to be carried out.
c
c
c*** ASK_Z_ARRAY( kzstart, karraystart, Zarray, Narray )  This subroutine will
c    ---------------------------------------------------  return (some of) the
c  stored z-values (that are used for Z-interpolation), in the user-supplied
c  array variable  Zarray  (the other inputs to ASK_Z_ARRAY must have values
c  supplied by the user, and may be constant integers).
c    kzstart      INTEGER: index of the first stored z-value to be returned.
c    karraystart  INTEGER: the index in the user-supplied array Zarray where
c                   the first returned z-value will be placed.
c    Zarray       SINGLE-PRECISION REAL ARRAY: is where the stored z-values are
c                   returned; the array positions  Zarray(karraystart)  through
c                   Zarray( min{ Narray , karraystart + nzuse - kzstart } )
c                   will contain the stored z-values  kzstart  through  nzuse
c                   (where  nzuse  is the total number of stored z-values); any
c                   subsequent elements of  Zarray  (up to element  Narray )
c                   will be filled with values of -1.0 (note that in no case
c                   will elements beyond  Narray  be overwritten).
c    Narray       INTEGER: the size of the user-supplied array  Zarray , i.e.,
c                   the array is specified as  "dimension Zarray(Narray)" .
c
c
c           ======================================================
c           The subroutines that control matrix T,R-edge handling:
c           ======================================================
c
c
c*** SET_LOGT6_LIMITS( VLO, DVLO, VHI, DVHI )  These subroutines can be called
c    ----------------------------------------  at ANY TIME, and their effects
c*** SET_LOGR_LIMITS( VLO, DVLO, VHI, DVHI )   will last until they are called
c    ---------------------------------------   again; they are used to set (or
c  reset) the LogT6 and LogR boundaries.  These input boundaries  VLO  and  VHI
c  must not lie outside the matrix edges, and extrapolation is never allowed
c  more than one grid-spacing beyond the edge of the matrix.  All these input
c  values should be SINGLE-PRECISION REAL, given in terms of  log10(T6)  and
c  log10(R) = log10(rho/T6**3); values of -90.0 or less mean "leave the present
c  values unchanged", and are ignored.
c    If  VLO > -90.0 , then (for subroutine SET_LOGT6_LIMITS) it is used to set
c  the lower boundary  LogT6_lo  (minimum -2.25: logT=3.75), or (for subroutine
c  SET_LOGR_LIMITS), to set the lower boundary  LogR_lo  (minimum -8.0).
c    If  VHI > -90.0 , then it is used to set the upper boundary  LogT6_hi
c  (maximum +2.70: logT=8.70) or the upper boundary  LogR_hi  (maximum +1.0).
c    If  DVLO  is non-negative, it is used to set the amount of "extrapolation"
c  dLogT6 or dLogR allowed beyond the lower boundary, except that the extreme
c  values  LogT6_lo - dLogT6  and  LogR_lo - dLogR  are not allowed to lie more
c  then one grid spacing beyond the matrix edge; if  -90.0 < DVLO < 0.0 , then
c  the amount of extrapolation is set to its default (namely, dLogT6 = 0.05 or
c  dLogR = 0.5); if  DVLO < -90.0 , then it is ignored.
c    If  DVHI  is non-negative, it is used to set the amount of "extrapolation"
c  dLogT6 or dLogR allowed beyond the upper boundary, except that the extreme
c  values  LogT6_hi + dLogT6  and  LogR_hi + dLogR  are not allowed to lie more
c  then one grid spacing beyond the matrix edge; if  -90.0 < DVHI < 0.0 , then
c  the amount of extrapolation is set to its default (namely, dLogT6 = 0.20 or
c  dLogR = 0.5); if  DVHI < -90.0 , then it is ignored.
c    NOTE that even if the boundaries are set inside the matrix, the opacity
c  calculation continues to use all available matrix entries: interpolation is
c  still used (not extrapolation) as long as T6 and R lie inside the edge of
c  matrix.  The boundaries and "extrapolation" distances are used to obtain the
c  value of FTREDGE to return, and whenever  FTREDGE = 0.0  the opacity is NOT
c  calculated (even if T6 and R lie inside the matrix edges).
c
c
c*** ASK_LOGT6_LIMITS( VLO, DVLO, VHI, DVHI )  These subroutines can be called
c    ----------------------------------------  at any time; they return the
c*** ASK_LOGR_LIMITS( VLO, DVLO, VHI, DVHI )   current values of the lower and
c    ---------------------------------------   upper LogT6 or LogR boundaries
c  and the corresponding allowed amounts of "extrapolation" dLogT6 or dLogR
c  (SINGLE-PRECISION REAL variables must be supplied to hold returned values).
c
c  NOTE ALSO that the OPAL arrays have a "cut-out" region where opacity values
c  are not available at high T6,R values; one grid-spacing of extrapolation is
c  allowed into this "cut-out" region.  The boundary of this "cut-out" lies
c  roughly at LogRho = 4 for 7.0 < logT < 7.5, and at somewhat higher densities
c  for log T > 7.5 (up to LogRho = 6 at logT = 8.7, the high-T matrix edge).
c
c  NOTE ALSO that the X=0.0 and X=0.03 matrices have small "cut-outs" at low T6
c  and small R.  As noted by Rogers and Iglesias, "as a result of the mixing
c  procedure used to calculate the OPAL opacity data, a few X=0.0 and X=0.03
c  low T - small R table values fell outside the range of T and R accessible
c  from the X=0.35 data directly calculated for this purpose.  These T-R
c  locations are filled in with 9.999 (or for diagnostic purposes in some cases
c  larger values)."  In the present program, these regions are treated as a
c  "cut-out" in the opacity tables (similar to the high T - large R corner),
c  and one grid spacing of extrapolation is allowed into them, as at any other
c  edge.  For X > 0.1 they have no effect; for 0.03 < X < 0.1, the corner
c  ( -8.0 < logR < -7.5 , 3.70 < logT < 3.95 ) [i.e., T6 < 0.008912509] is
c  extrapolated; and for X < 0.03, a ragged part of the region ( logR < -4.5 ,
c  logT < 4.0 ) [i.e., T6 < 0.01] is considered to be outside the opacity grid
c  (i.e., the opacity is not calculated, and FTREDGE = 0.0 is returned).
c  Presumably very few users will have applications that take them into these
c  low T - small R regions at low hydrogen abundances X; in any case, they are
c  at temperatures where molecular opacities may become non-negligible.
c
c
c           ======================================================
c           The subroutines that control how smoothing is handled:
c           ======================================================
c
c
c*** SET_SMOOTH( initsmooth, lowCOsmooth, interpCOsmooth )  This subroutine
c    -----------------------------------------------------  allows the user to
c  control how and whether the opacity smoothing is carried out when the OPAL
c  opacities are read in, and which subroutine is used to interpolate in C and
c  O when OPAC or OPAL is called.  The smoothing and its effects are discussed
c  in more detail further below.
c  --- IT IS RECOMMENDED THAT THE DEFAULT SMOOTHING VALUES NOT BE CHANGED.
c
c    initsmooth      INTEGER: if  initsmooth = 2  (the default), then the OPAL
c                      opacities are smoothed by the subroutine OPALTAB when
c                      they are read in, in order to remove random numerical
c                      errors; if  initsmooth = 0 , then this initial smoothing
c                      will not be carried out.  A value  initsmooth = 1  means
c                      that opacities used for CNO-interpolation opacity shifts
c                      will not be smoothed.  A value   initsmooth < 0  means
c                      "do not change the current initial-smoothing setting".
c    lowCOsmooth     INTEGER: if  lowCOsmooth = 1  (the default), then the OPAL
c                      opacities for the three mixes having max{C,O} = 0.01 may
c                      be smoothed in the CO-direction when they are read in;
c                      this is only done at (T6,R) points where opacity-changes
c                      between mixes with C,O = 0.0, 0.03, 0.1 are monotonic
c                      but the opacity at C,O = 0.01 does not fit the trend;
c                      the resulting adjustments are small, and only occur at a
c                      small minority of (T6,R) points.  If  lowCOsmooth = 0 ,
c                      then this initial CO-direction smoothing is not carried
c                      out.  A value  lowCOsmooth < 0  means "do not change the
c                      current initial-CO-smoothing setting".
c    interpCOsmooth  INTEGER: if  interpCOsmooth = 1  (the default), then the
c                      subroutine COINTSMO is called by OPAC or OPAL in order
c                      to interpolate in C and/or O.  If  interpCOsmooth = 0 ,
c                      then the older subroutine COINTERP is used instead; this
c                      yields less smooth interpolation, and it has been less
c                      thoroughly tested.  A value  interpCOsmooth < 0  means
c                      "do not change the current CO-interpolation setting".
c
c
c*** ASK_SMOOTH( initsmooth, lowCOsmooth, interpCOsmooth )  This subroutine
c    -----------------------------------------------------  returns the current
c  smoothing settings described above (INTEGER variables must be supplied to
c  hold the returned values), allowing the user to check how smoothing is being
c  handled.
c
c
c******************************************************************************
c
c
c    +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c    Details of how the opacity interpolation is performed by OPAC or OPAL
c    +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c  In general, a 6-variable interpolation of  log10(Kappa)  is performed, using
c  the arguments of OPAC or OPAL, on a subgrid of the stored opacity matrices.
c  In general, 4 stored values ("@" in the diagram
c  at upper right) are used along each interpolation    1:|-----|--v--|
c  direction.  A quadratic fit is performed for           @     @  *  @     @
c  each of the 2 sets of 3 adjacent stored values               |--^--|-----|:2
c  ("1" and "2" at upper right), and then linear
c  interpolation between these overlapping quadratics
c  is used to obtain smoothed results.  [For a value      @  *  @     @     @
c  near (or beyond) the edge of the matrix, as in       1:|--^--|-----|
c  the diagrams at lower right, a single quadratic
c  is used.]  This procedure produces results that     *  @     @     @     @
c  are similar to bicubic spline interpolation,        ^--|-----|-----|:1
c  but requires storage of only local information.
c    --- FIRST, unless excess C = O = 0.0, for each ( Z_i , X_j , T6_k , R_n )
c  grid value that will be needed, an interpolation is performed in the excess
c  C and O values ("exC" and "exO" in the arguments to OPAC or OPAL).  The
c  actual C' and O' values used at each ( Z_i , X_j ) gridpoint are adjusted by
c  a factor  cmod = ( 1 - X_i - Z_j ) / ( 1 - X - Z )  , i.e., C' and O' are
c  set to be proportional to the maximum possible value for their ( Z_i , X_j )
c  values, so as to avoid out-of-range C' and O' values (note that X is "xh",
c  Z is "z" in the arguments to the subroutines OPAC or OPAL described above).
c  The above formula for  cmod  can lead to problems when  ( 1 - X - Z )  is
c  small, therefore: as X is increased from 0.7 to 0.8,  cmod  switches over
c  smoothly to from the above formula to a constant value of unity (note that
c  since the largest grid {X_i,Z_j} values are X=0.7 and Z=0.1 respectively, at
c  X > 0.8 a value of  cmod = 1.0  will never yield  X_i + Z_j + C' + O' > 1).
c     The 2-D bi-quadratic interpolation of  log(Kappa)  in  log(C'+Z_i+0.001)
c  and  log(O'+Z_i+0.001)  is performed by the subroutine COINTSMO (or by the
c  older subroutine COINTERP, if you so choose: see description of subroutine
c  SET_SMOOTH above).  The function QCHK is used to evaluate the quadratic: it
c  checks whether 2 of the 3 grid-points are excessively close together (as may
c  happen near  C + O = 1 - Z - X  for some values of Z) and, if so, uses more
c  nearly liner interpolation to avoid amplifying small errors in the stored
c  opacity values.  For the special case where C or O is slightly negative
c  (slight depletion in C or O), the function QCHK does a linear extrapolation
c  using a combination of the lowest three C or O gridpoints.  If C and/or O is
c  zero (to within an accuracy of 1.E-6), then interpolation in that direction
c  is not necessary, and is not performed (unless the user has specified that
c  the old subroutine COINTERP should be used).
c    --- SECOND, unless Z is within 1.E-6 of a stored z-value (or Z < 1.E-8, if
c  the stored value is 0.0), for each ( X_j , T6_k , R_n ) grid value that will
c  be needed, an interpolation is performed in log(Z+0.001).  If there are only
c  2 stored z-values (numz = 2), linear interpolation is used; for numz = 3, a
c  quadratic is used,  while two overlapping quadratics are used for numz > 3
c  (unless Z is near the end of the range of stored z-values).  The subroutine
c  QZLOG4INT is called to perform this Z-interpolation.  Since numerical errors
c  in the stored opacities, or in the CO-interpolation, may be comparable to
c  the opacity differences between adjacent stored z-values, the opacity at Z
c  is not allowed to lie outside the range of the two opacities at the stored
c  z-values bracketting it.  (Note that, when opacities are read in for values
c  of Z different from one of those available in the OPAL opacity files, the
c  same type of interpolation with the same constraint is performed by the
c  subroutines READZEXCO, READEXCO, or READCO.)
c    --- THIRD, a two-variable interpolation in performed in the temperature
c  and density variables T6 and R (note slt = log10(T6) and slr = log10(R) in
c  the input to OPAL); the 2-D quadratic interpolation in  log10(T6)  and
c  log10(R)  uses two overlapping quadratics in each direction, unless T6 or R
c  is within one grid spacing of an edge of the table (in which case a single
c  quadratic is used in the relevant direction).  NOTE that the high-T,RHO
c  "cutout" has been filled in (by subroutine REVISE_HITR_FOR_INITSMOOTH) with
c  "reasonable" values, at the time when the opacities were read in; for T or
c  RHO above the actual upper edges of the matrix, switch from extrapolation
c  with the slope of the quadratic at the edge of the matrix to 2-point linear
c  extrapolation one grid-spacing beyone the edge of the matrix.
c    --- FOURTH, unless X is within 1.E-6 of one of the tabulated X-values
c  (X is the input variable xh in OPAC or OPAL),  log(Kappa)  is interpolated
c  quadratically in  log(X+Xdel) , where Xdel = 0.03 is generally used (for
c  0.03 < X < 0.35, two overlapping quadratics are used).  NOTE that pre-1997
c  versions of the opacity interpolation programs used a value of Xdel = 0.005,
c  which led to non-monotonic behavior of the opacity as a function of X for
c  small X values: for temperatures logT > 5.0 [T6 > 0.1], the interpolated
c  opacity first dropped slightly as X was increased from 0.0 to about 0.005,
c  then increased monotonically thereafter (at least up to X = 0.1).  This
c  spurious dip in the opacity for small X values was small (delta log(Kappa)
c  of order 0.03), but it seemed worth getting rid of this dip by setting Xdel
c  to 0.03, in order to obtain qualitatively correct behavior of the opacity
c  for X close to zero.  However, at low temperatures (i.e., for logT < 4),
c  the X=0.0 opacities are very small with respect to the X=0.03 and X=0.1
c  opacities, and a smaller value of Xdel works better near X=0.0.  Although
c  such low X values are unlikely to be encountered at such low temperatures,
c  provision was made in the program to reduce the value of Xdel used in such
c  cases to a value that works better (down to a minimum value of 0.001); this
c  was done ONLY for the quadratic that uses opacities at X = 0.0, 0.03, 0.1
c  (note that for the higher X-values, the value of Xdel used is irrelevant).
c     --- FIFTH, unless X is within 1.E-6 of one of the tabulated X-values or
c  X < 0.03 or C+O > 0.3 or the "accurate-X" feature was turned off (see the
c  subroutine SET_XHI described above): for the X-values available in 'GN93hz'
c  but not 'Gz???.x??', Z-interpolation and (T6,R)-interpolation is performed
c  in delta-logKappa values, which are then interpolated in X to give opacity
c  corrections.  Improvements are small for X < 0.76, but large for X > 0.76 .
c     --- SIXTH, if (and only if) CNO- and/or user-interpolation is enabled and
c  the corresponding CNO-interconverted opacity-files (or user-specified files)
c  were available to read in: the delta-logKappa values corresponding to the
c  interconversion of the CNO elements (and/or the user-specified composition
c  shift) are multiplied by the relevant factors FCN, FCON, FCNONE, FU and then
c  interpolated in Z, (T6,R), and X in order to give the corresponding opacity
c  corrections.
c
c     NOTE: for the Ferguson et al. (2005) molecular opacity interpolation,
c  MODIFIED quadratics are used for logT < 3.48, where sudden jumps in the
c  opacity can occur between one grid-point and the next in any of the Z-, X-,
c  R-, and/or T-directions.  For a large jump, the original quadratics would
c  lead to spurious wiggles on each side of the jump, with opacity errors of
c  order a factor of 2 (occasionally more than an order of magnitude).  The
c  MODIFIED 3-pt quadratics switch over (smoothly), for a large jump, to linear
c  interpolation in the flat segment, with a quadratic in the "jump" segment
c  whose slope matches that of the flat segment where the two meet at the
c  middle of the three points (two adjacent such modified 3-pt quadratics are
c  still overlapped in general to get the final interpolated value).  This gets
c  rid of almost all the spurious wiggles next to opacity jumps.  EXAMPLE:
c 
c  Original quadratics:            * *
c                                 *   *                           * *
c    combine              4      4     5   4 * * 5 * 6   -->     4   * 5 * * 6
c                         *     *                               *
c                         *    *                               *  with spurious
c                         *   *                                *  wiggles in
c                        *    *                                *  between pts
c                       *     *                               *   2 and 3 and
c  1 * 2 * * 3   2     3      3                  1 * * 2 *   3    between pts
c                 *   *                                   * *     4 and 5
c                  * *
c
c  Modified quadratics:
c                          4       4 * * 5   4 * * 5 * 6    -->     4 * * 5 * 6
c    combine               *     *                                 *
c                          *    *                                 *
c                          *   *                                  *
c                         *    *                                  *
c                        *     *                                 *
c  1 * 2 * * 3   2 * * 3       3                      1 * 2 * * 3
c
c  The modified quadratic routines QUADSL, QDERSL, and QCHKSL are used only for
c  Ferguson et al. 2005 opacity interpolation at logT < 3.48; they are similar
c  to the functions QUAD, QDER, and QCHK [except that QCHKSL assumes that it
c  is always the case that  x1 < x2  and that x2 and x3 are the only pair of
c  points that may coincide (or almost coincide)].
c
c
c    +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c    Details of the makeup of Z (relative metal abundances), for various mixes
c    +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c  Note that the total metallicity Z for the OPAL mixes includes the following
c  19 elements: {C,N,O,Ne,Na,Mg,Al,Si,P,S,Cl,Ar,K,Ca,Ti,Cr,Mn,Fe,Ni}.  Their
c  relative abundances (by mass fraction and/or number fraction) for any mix
c  can be obtained by calling the subroutine ASK_OPAL_Z_MIX, while their atomic
c  weights (and their atomic numbers, i.e., nuclear charges) can be obtained by
c  calling the subroutine ASK_OPAL_MIX_WT (see descriptions further above).
c
c
c  The makeup of Z in the files 'GN93hz', 'Alrd96a2', 'C95hz', and 'W95hz' is
c  shown below, along with the maximum, mean, and spread of opacity differences
c  relative to 'GN93hz' for Z = 0.1 (where the opacity shifts are largest), for
c  T6 > 0.01 (logT > 4), for each X-value.  Note that [i/Fe] gives the log of
c  the enhancement of element i relative to Fe, where the solar reference is
c  the 'GN93hz' mix; note that for i = Fe, [i/Fe] = 0.0 by definition.  Newer
c  "GS98" and "AGS04" mixes are given further below.  NOTE THAT THE CO-RICH
c  OPACITY FILES  'Gz???.x??'  HAVE THE SAME COMPOSITION AS THE FILE  'GN93hz'.
c
c  NOTE: for this GN93hz mix, Z/X = 0.02448:
c
c   'Gx..z...'  and
c       'GN93hz'        'Alrd96a2'           'C95hz'             'W95hz'
c   --------------- ------------------- ------------------- -------------------
c     [O/Fe] = 0.0      [O/Fe] = 0.3        [O/Fe] = 0.4        [O/Fe] = 0.5
c   =============== =================== =================== ===================
c i  Ni/Nz   Xi/Z    Ni/Nz  Xi/Z [i/Fe]  Ni/Nz  Xi/Z [i/Fe]  Ni/Nz  Xi/Z [i/Fe]
c - ------- ------- ------- ------- --- ------- ------- --- ------- ------- ---
c C .245518 .173285 .147909 .102693 0.0 .131157 .091924 0.0 .108211 .076451 0.0
c N .064578 .053152 .038904 .031499 0.0 .034498 .028196 0.0 .028462 .023450 0.0
c O .512966 .482273 .616594 .570253 .30 .688325 .642620 .40 .714945 .672836 .50
c Ne.083210 .098668 .100010 .116656 .30 .044451 .052341 0.0 .071502 .084869 .29
c Na.001479 .001999 .001778 .002363 .30 .000790 .001060 0.0 .000652 .000882 0.0
c Mg.026308 .037573 .031622 .044428 .30 .035301 .050066 .40 .029125 .041639 .40
c Al.002042 .003238 .000617 .000962 -.3 .001091 .001718 0.0 .000900 .001428 0.0
c Si.024552 .040520 .029512 .047912 .30 .032945 .053992 .40 .021591 .035669 .30
c P .000195 .000355 .000234 .000420 .30 .000104 .000188 0.0 .000086 .000157 0.0
c S .011222 .021142 .013490 .024999 .30 .015059 .028172 .40 .010575 .019942 .33
c Cl.000219 .000456 .000263 .000539 .30 .000117 .000242 0.0 .000096 .000201 0.0
c Ar.002291 .005379 .002754 .006360 .30 .001224 .002853 0.0 .001010 .002373 0.0
c K .000091 .000210 .000055 .000124 0.0 .000122 .000279 .40 .000040 .000092 0.0
c Ca.001586 .003734 .001906 .004415 .30 .002127 .004975 .40 .002210 .005209 .50
c Ti.000075 .000211 .000089 .000245 .29 .000099 .000275 .39 .000137 .000387 .62
c Cr.000329 .001005 .000198 .000595 0.0 .000176 .000533 0.0 .000145 .000443 0.0
c Mn.000170 .000548 .000072 .00023 -.15 .000036 .000116 -.4 .000075 .000242 0.0
c Fe.021877 .071794 .013177 .042538 0.0 .011687 .038085 0.0 .009642 .031675 0.0
c Ni.001293 .004459 .000816 .002769 .02 .000691 .002365 0.0 .000595 .002056 .02
c - ------- ------- ------- ------- --- ------- ------- --- ------- ------- ---
c h>.093729 .192623 .096583 .178899     .101569 .184919     .076879 .142395
c================== =================== =================== ===================
c where  h>  is the sum of everything heavier than Ne
c
c opacity-shifts        'Alrd96a2'           'C95hz'             'W95hz'
c  dLogKappa        ------------------- ------------------- -------------------
c for T6 > .01          [O/Fe] = 0.3        [O/Fe] = 0.4        [O/Fe] = 0.5
c for Z = 0.1,      =================== =================== ===================
c  relative           max   mean  sigma   max   mean  sigma   max   mean  sigma
c to 'GN93hz'       ------ ------ ----- ------ ------ ----- ------ ------ -----
c              X=0: -.1512 -.0270 .0321 -.1844 -.0351 .0371 -.2669 -.0537 .0514
c            X=.03: -.1457 -.0258 .0303 -.1835 -.0343 .0364 -.2270 -.0514 .0487
c            X=.10: -.1464 -.0249 .0297 -.1849 -.0334 .0361 -.2286 -.0498 .0477
c            X=.35: -.1490 -.0236 .0292 -.1886 -.0321 .0359 -.2334 -.0474 .0471
c            X=.70: -.1539 -.0227 .0297 -.1952 -.0311 .0367 -.2416 -.0458 .0480
c
c------------------------------------------------------------------------------
c NOTE: if you are using 'Alrd96a2' having [O/Fe] = 0.3 (khighz = 2), then your
c        mix Al abundance will go negative if you extrapolate  [O/Fe] > 0.476 ;
c        the Mn abundance will go negative if you extrapolate  [O/Fe] > 0.644 .
c  --- If you are using 'C95hz' having [O/Fe] = 0.4 (khighz = 3), then your mix
c        Mn abundance will go negative if you extrapolate  [O/Fe] > 0.546 .
c  --- If you are using 'W95hz' having [O/Fe] = 0.5 (khighz = 4), then your mix
c        Ti abundance will go negative if you extrapolate  [O/Fe] < -0.501 .
c
c  By default, the CNO-interpolation files for the "GN93" mix  are  'GN93hz' ,
c   'GN93hz.CtoN' , 'GN93hz.COtoN' , 'GN93hz.CNOtoNe' , and 'GN93hz.user' ;
c  for other mixes, the default filenames are obtained by appending  '.CtoN' ,
c   '.COtoN' , '.CNOtoNe', and '.user' to the main mix filename ('GS98hz' or
c  'AGS04hz').  If such non-GN93 files are not found, CNO-interpolation opacity
c  differences are obtained from the "GN93" files instead (if these are found).
c------------------------------------------------------------------------------
c
c
c  Opacities for the "GS98" solar/meteoritic abundances (N. Grevesse & A.J.
c  Sauval 1998, Space Sci. Rev. 85, 161) are contained in the file  'GS98hz' ;
c  three other files were created with opacities for [O/Fe] enhancements (and
c  alpha-element enhancements) RELATIVE TO THE "GS98" MIX, patterned after the
c  corresponding three cases above.  These files and compositions are:
c
c  NOTE: for this GS98hz mix, Z/X = 0.02300:
c
c        GS98hz    GS98hz_OFe.3_Alrd96a2  GS98hz_OFe.4_C95    GS98hz_OFe.5_W95
c   --------------- ------------------- ------------------- -------------------
c     [O/Fe] = 0.0      [O/Fe] = 0.3        [O/Fe] = 0.4        [O/Fe] = 0.5
c   =============== =================== =================== ===================
c i  Ni/Nz   Xi/Z    Ni/Nz  Xi/Z [i/Fe]  Ni/Nz  Xi/Z [i/Fe]  Ni/Nz  Xi/Z [i/Fe]
c - ------- ------- ------- ------- --- ------- ------- --- ------- ------- ---
c C .245825 .171836 .148069 .101930 0.0 .131883 .091638 0.0 .108877 .076359 0.0
c N .061748 .050335 .037193 .029858 0.0 .033128 .026843 0.0 .027349 .022368 0.0
c O .501922 .467356 .603216 .553139 .30 .676395 .626052 .40 .702986 .656744 .50
c Ne.089265 .104831 .107280 .124072 .30 .047890 .055905 0.0 .077089 .090832 .29
c Na.001562 .002090 .001877 .002473 .30 .000838 .001114 0.0 .000692 .000929 0.0
c Mg.028224 .039924 .033921 .047252 .30 .038036 .053480 .40 .031401 .044563 .40
c Al.002294 .003603 .000693 .001071 -.3 .001231 .001921 0.0 .001016 .001601 0.0
c Si.026954 .044057 .032394 .052144 .30 .036324 .059017 .40 .023820 .039063 .30
c P .000235 .000423 .000282 .000501 .30 .000126 .000226 0.0 .000104 .000188 0.0
c S .012602 .023513 .015145 .027829 .30 .016982 .031497 .40 .011933 .022339 .33
c Cl.000141 .000292 .000170 .000346 .30 .000076 .000156 0.0 .000063 .000130 0.0
c Ar.001865 .004335 .002241 .005131 .30 .001000 .002312 0.0 .000826 .001927 0.0
c K .000100 .000228 .000060 .000135 0.0 .000135 .000305 .40 .000044 .000101 0.0
c Ca.001670 .003896 .002007 .004611 .30 .002251 .005218 .40 .002339 .005474 .50
c Ti.000070 .000195 .000082 .000226 .29 .000092 .000256 .39 .000129 .000362 .62
c Cr.000369 .001117 .000222 .000663 0.0 .000198 .000596 0.0 .000163 .000496 0.0
c Mn.000244 .000779 .000104 .000327-.15 .000052 .000165 -.4 .000108 .000346 0.0
c Fe.023517 .076433 .014165 .045339 0.0 .012616 .040761 0.0 .010416 .033965 0.0
c Ni.001393 .004757 .000878 .002955 .02 .000747 .002537 0.0 .000646 .002214 .02
c - ------- ------- ------- ------- --- ------- ------- --- ------- ------- ---
c h>.101240 .205642 .104241 .191003     .110704 .199561     .083700 .153698
c================== =================== =================== ===================
c where  h>  is the sum of everything heavier than Ne
c
c
c  Opacities can be read in for the newer "AGS04" solar/meteoritic abundances
c  (M. Asplund, N. Grevesse, & A.J. Sauval 2004, astro-ph/0410214 [v2];
c  ALSO:  M. Asplund, N. Grevesse, & A.J. Sauval 2005, Cosmic Abundances as
c    Records of Stellar Evolution and Nucleosynthesis [eds. F.N. Bush & T.G.
c    Barnes], ASP Conf. Series, Vol. 336, p. 25;
c  ALSO:  M. Asplund, N. Grevesse, & A.J. Sauval 2006, Nucl. Phys. A 777, 1).
c
c  NOTE: for this AGS04hz mix, Z/X = 0.016555973
c
c      AGS04hz    AGS04hz_OFe.3_Alrd96a2  AGS04hz_OFe.4_C95   AGS04hz_OFe.5_W95
c   --------------- ------------------- ------------------- -------------------
c     [O/Fe] = 0.0      [O/Fe] = 0.3        [O/Fe] = 0.4        [O/Fe] = 0.5
c   =============== =================== =================== ===================
c i  Ni/Nz   Xi/Z    Ni/Nz  Xi/Z [i/Fe]  Ni/Nz  Xi/Z [i/Fe]  Ni/Nz  Xi/Z [i/Fe]
c - ------- ------- ------- ------- --- ------- ------- --- ------- ------- ---
c C .257854 .176688 .157301 .106433 0.0 .138833 .094547 0.0 .116312 .080363 0.0
c N .063296 .050578 .038613 .030467 0.0 .034080 .027065 0.0 .028551 .023004 0.0
c O .480145 .438260 .584425 .526743 .30 .649367 .589077 .40 .684888 .630346 .50
c Ne.072700 .083693 .088481 .100581 .30 .039143 .044785 0.0 .063935 .074215 .29
c Na.001956 .002565 .002381 .003084 .30 .001053 .001373 0.0 .000882 .001166 0.0
c Mg.035594 .049354 .043324 .059318 .30 .048138 .066338 .40 .040329 .056385 .40
c Al.002827 .004352 .000865 .001315 -.3 .001522 .002328 0.0 .001275 .001979 0.0
c Si.033992 .054464 .041375 .065461 .30 .045972 .073207 .40 .030593 .049426 .30
c P .000264 .000466 .000321 .000560 .30 .000142 .000249 0.0 .000119 .000212 0.0
c S .015184 .027771 .018483 .033381 .30 .020536 .037330 .40 .014644 .027007 .33
c Cl.000178 .000361 .000216 .000431 .30 .000096 .000193 0.0 .000080 .000163 0.0
c Ar.001590 .003623 .001935 .004355 .30 .000856 .001939 0.0 .000717 .001648 0.0
c K .000121 .000269 .000074 .000163 0.0 .000163 .000361 .40 .000054 .000121 0.0
c Ca.002050 .004686 .002495 .005633 .30 .002771 .006297 .40 .002924 .006742 .50
c Ti.000082 .000223 .000099 .000267 .29 .000109 .000296 .39 .000153 .000422 .62
c Cr.000458 .001358 .000279 .000817 0.0 .000247 .000728 0.0 .000207 .000619 0.0
c Mn.000310 .000972 .000133 .000412-.15 .000066 .000206 -.4 .000140 .000442 0.0
c Fe.029696 .094613 .018112 .056981 0.0 .015989 .050629 0.0 .013395 .043032 0.0
c Ni.001703 .005704 .001088 .003598 .02 .000917 .003052 0.0 .000802 .002708 .02
c - ------- ------- ------- ------- --- ------- ------- --- ------- ------- ---
c h>.126005 .250781 .131180 .235776     .138577 .244526     .106314 .192072
c================== =================== =================== ===================
c where  h>  is the sum of everything heavier than Ne
c
c  Unlike earlier papers, "AGS04" above gives meteoritic H, He, C, N, O, Ne, Ar
c  abundances.  There are almost no noble gases (He, Ne, Ar ...), less C, N, O
c  (relative to Si or Fe) than in the solar mix, and almost no hydrogen.  [For
c  other elements, meteoritic abundances were used in the above "AGS04" mix,
c  instead of the less-accurate solar-surface observations.]  The actual values
c  for the meteoritic mix are given below [with many digits, to show the actual
c  abundances of He, Ne, Ar; note that Ab_i = log10(N_i/N_H_sun) + 12.0]:
c
c    Complete "AGS04" meteoritic abundances   Meteoritic mix (components of Z)
c    ======================================= ==================================
c i   Ab_i        Ni              Xi              Ni/Nz           Xi/Z
c -- ----- ---------------- ---------------- ---------------- ----------------
c H   8.25 .312727500321341 .020944433890450               [Z=.979055556989581]
c He  1.29 .000000034289886 .000000009119969
c C   7.40 .044173943244219 .035255788483962 .064274280534767 .036009997831346
c N   6.25 .003127275003213 .002910629954482 .004550269595690 .002972895596887
c O   8.39 .431684461811492 .458939274347532 .628112551500661 .468757131371265
c Ne -1.06 .000000000153167 .000000000205377 .000000000222863 .000000000209770
c Na  6.27 .003274596717318 .005002390294590 .004764626668792 .005109403913677
c Mg  7.53 .059588954783339 .096237981691629 .086703538675350 .098296752420816
c Al  6.43 .004732763251461 .008485288886437 .006886298360263 .008666810403005
c Si  7.51 .056906999803204 .106202066768971 .082801221741094 .108473994157720
c P   5.40 .000441970109086 .000909645014595 .000643078446095 .000929104592789
c S   7.16 .025419977789240 .054153160875713 .036986754263261 .055311632204228
c Cl  5.23 .000297994997793 .000702016082572 .000433590770473 .000717033959472
c Ar -0.45 .000000000623973 .000000001656328 .000000000907898 .000000001691761
c K   5.06 .000202569633331 .000526280567971 .000294744287793 .000537539023413
c Ca  6.29 .003431964862220 .009140199460691 .004993601570053 .009335731149717
c Ti  4.89 .000137278594489 .000436941664783 .000199744062802 .000446288938011
c Cr  5.63 .000766751174096 .002649167869084 .001115643667846 .002705840184626
c Mn  5.47 .000518980052336 .001894561100742 .000755129993520 .001935090493299
c Fe  7.45 .049714940755353 .184489597541457 .072336581572827 .188436290692971
c Ni  6.19 .002851042029444 .011120564522665 .004148343157951 .011358461165226
c -- ----- ---------------- ---------------- ---------------- ----------------
c h>       .208286785176682 .481949863998228 .303062898146020 .492259974990732
c    ======================================= ==================================
c  where  h>  is the sum of everything heavier than Ne
c
c------------------------------------------------------------------------------
c
c  Meteoritic mixes as obtained from solar abundances by reducing C,N,O,Ne,Ar
c  as per the AGS04 meteoritic abundances, and "antimeteor" Z-mixes that yield
c  solar abundances when added to 50% and 20% as much meteoritic Z-material:
c
c              GN93hz.meteor          GN93hz.5antimeteor GN93hz.2antimeteor
c    ================================= ================= =================
c i        Ni/Nz            Xi/Z         Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ---------------- ---------------- -------- -------- -------- --------
c C  .062096387323045 .034055950767625 .3096329 .2428995 .2728055 .2011308
c N  .004396103132102 .002811584920288 .0856148 .0783222 .0735314 .0632201
c O  .606837084080657 .443326132928943 .4801523 .5017450 .4989998 .4900612
c Ne .000000000215357 .000000000198429 .1122968 .1480020 .0955898 .1184016
c Na .005283859474681 .005546683967014 .0001500 .0002252 .0009138 .0012895
c Mg .093987679773822 .104307149947153 .0026495 .0042059 .0162384 .0242262
c Al .007295227181013 .008987793491910 .0002060 .0003631 .0012607 .0020880
c Si .087714215091835 .112486310445815 .0024732 .0045368 .0151550 .0261267
c P  .000696654916553 .000985278857158 .0000197 .0000399 .0001204 .0002289
c S  .040091598026506 .058690042443895 .0011309 .0023680 .0069273 .0136324
c Cl .000782397036934 .001266565623746 .0000219 .0000507 .0001351 .0002939
c Ar .000000000877017 .000000001599745 .0030924 .0080685 .0026323 .0064548
c K  .000325105632923 .000580403334678 .0000097 .0000248 .0000566 .0001359
c Ca .005666126529857 .010369588461345 .0001590 .0004162 .0009783 .0024069
c Ti .000267944210671 .000586040222841 .0000075 .0000235 .0000463 .0001360
c Cr .001175381889649 .002790592585741 .0000330 .0001122 .0002030 .0006479
c Mn .000607340179662 .001523534791034 .0000168 .0000602 .0001046 .0003529
c Fe .078157536632930 .199305017419850 .0022038 .0080385 .0135039 .0462918
c Ni .004619357794785 .012381327992788 .0001298 .0004978 .0007978 .0028745
c -- ---------------- ---------------- -------- -------- -------- --------
c h> .326670425248838 .519806331184714 .0123032 .0290313 .0590735 .1271863
c    ================================= ================= =================
c  (NOTE: some abundances would go negative beyond GN93hz.561743antimeteor)
c
c              GS98hz.meteor          GS98hz.5antimeteor GS98hz.2antimeteor
c    ================================= ================= =================
c i        Ni/Nz            Xi/Z         Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ---------------- ---------------- -------- -------- -------- --------
c C  .061833419528987 .033847976603222 .3108195 .2408300 .2734442 .1994336
c N  .004377442231746 .002794386850040 .0820144 .0741053 .0703603 .0598431
c O  .604274480285562 .440624098408040 .4657653 .4807222 .4865568 .4727025
c Ne .000000000214427 .000000000197201 .1207976 .1572465 .1026646 .1257972
c Na .005179390157206 .005426796827570 .0002843 .0004216 .0010191 .0014226
c Mg .093587138052187 .103667372071604 .0051357 .0080523 .0184132 .0271753
c Al .007606607490520 .009353799223261 .0004180 .0007276 .0014971 .0024528
c Si .089375982574740 .114401914525715 .0049037 .0088845 .0175839 .0299880
c P  .000779229621820 .001099992396139 .0000423 .0000845 .0001529 .0002876
c S  .041786601600009 .061056356041069 .0022925 .0047413 .0082210 .0160043
c Cl .000467537763442 .000755439983010 .0000264 .0000603 .0000926 .0001993
c Ar .000000000873527 .000000001590383 .0025233 .0065025 .0021445 .0052020
c K  .000331587065415 .000590861589288 .0000185 .0000466 .0000655 .0001554
c Ca .005537504221631 .010115144589889 .0003042 .0007864 .0010898 .0026522
c Ti .000232110957854 .000506712319369 .0000127 .0000391 .0000456 .0001327
c Cr .001223556258112 .002899506965060 .0000673 .0002257 .0002409 .0007605
c Mn .000809072444438 .002025771911462 .0000439 .0001556 .0001588 .0005296
c Fe .077979330676706 .198476752244634 .0042777 .0154111 .0153411 .0520243
c Ni .004619007981672 .012357115663043 .0002527 .0009569 .0009081 .0032370
c -- ---------------- ---------------- -------- -------- -------- --------
c h> .329514657739278 .522733537941497 .0206032 .0470960 .0669741 .1422236
c    ================================= ================= =================
c  (NOTE: some abundances would go negative beyond GS98hz.624814antimeteor)
c
c             AGS04hz.meteor         AGS04hz.5antimeteor AGS04hz.2antimeteor
c    ================================= ================= =================
c i        Ni/Nz            Xi/Z         Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ---------------- ---------------- -------- -------- -------- --------
c C  .064274208429525 .036009888957169 .3303785 .2470271 .2883952 .2048236
c N  .004550290959465 .002972903901491 .0853040 .0743805 .0725636 .0600990
c O  .628110449385059 .468754671183736 .4247136 .4230127 .4568036 .4321613
c Ne .000000000222945 .000000000209847 .0999372 .1255395 .0841701 .1004316
c Na .004764660515098 .005109430493010 .0009033 .0012928 .0015125 .0020561
c Mg .086704154588141 .098297263764627 .0164453 .0248824 .0275300 .0395653
c Al .006886347278212 .008666855488115 .0013066 .0021946 .0021869 .0034890
c Si .082801809933137 .108474558443967 .0157052 .0274587 .0262910 .0436619
c P  .000643083014308 .000929109426030 .0001216 .0002344 .0002039 .0003734
c S  .036987017004729 .055311919937648 .0070150 .0140005 .0117437 .0222628
c Cl .000433593850556 .000717037689513 .0000829 .0001830 .0001382 .0002898
c Ar .000000000907947 .000000001691848 .0021853 .0054345 .0018405 .0043476
c K  .000294746381558 .000537541819713 .0000553 .0001347 .0000931 .0002153
c Ca .004993637042920 .009335779714580 .0009463 .0023611 .0015848 .0037560
c Ti .000199745481717 .000446291259625 .0000374 .0001114 .0000630 .0001783
c Cr .001115651593004 .002705854260520 .0002113 .0006841 .0003540 .0010884
c Mn .000755135357710 .001935100559721 .0001434 .0004904 .0002399 .0007794
c Fe .072337095427584 .188437270946424 .0137206 .0477009 .0229685 .0758481
c Ni .004148372626387 .011358520252416 .0007872 .0028767 .0013175 .0045731
c -- ---------------- ---------------- -------- -------- -------- --------
c h> .303065051003006 .492262535747757 .0596667 .1300402 .0980675 .2024845
c    ================================= ================= =================
c  (NOTE: some abundances would go negative beyond AGS04hz.998696antimeteor)
c
c  Since the solar C, N, and O abundances have been reduced more-or-less in
c  concert from one abundance paper to the next, it is not unreasonable to
c  consider them NOT to be independent, and to vary all of them together by
c  their quoted uncertainties (or by double this amount) to get mixes with
c  shifted C, N, and O that can still be considered "reasonable" (note that Ne
c  and Ar should be shifted by the same amount as O, since it is their ratios
c  Ne/O and Ar/O that are measured).  The shifted-CNO mixes would have the same
c  meteoritic abundances as "AGS04" above, but different "anti-meteor" mixes:
c
c  Z/X = 0.01809864    AGS04hiCNONe_OFe.5_W95          AGS04hiCNONe.2antimeteor
c         AGS04hiCNONe          ||     AGS04hiCNONe.5antimeteor    ||
c    ==================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +0.05 .261002 .181349 .117585 .082019 .3333123 .2540186 .2915434 .2104168
c N  +0.06 .065561 .053122 .029536 .024025 .0879866 .0781965 .0750329 .0631518
c O  +0.05 .486005 .449821 .692380 .643323 .4337738 .4403542 .4639452 .4460345
c Ne +0.05 .073584 .085897 .064632 .075741 .1006317 .1288455 .0850084 .1030764
c Na  0.00 .001765 .002347 .000795 .001061 .0006621 .0009658 .0012990 .0017945
c Mg  0.00 .032110 .045147 .036336 .051288 .0120428 .0185719 .0236341 .0345169
c Al  0.00 .002551 .003981 .001149 .001800 .0009568 .0016381 .0018774 .0030438
c Si  0.00 .030665 .049822 .027564 .044958 .0115013 .0204957 .0225709 .0380915
c P   0.00 .000238 .000427 .000107 .000192 .0000895 .0001759 .0001755 .0003266
c S   0.00 .013698 .025404 .013194 .024565 .0051371 .0104500 .0100819 .0194224
c Cl  0.00 .000161 .000330 .000072 .000148 .0000607 .0001365 .0001186 .0002526
c Ar +0.05 .001609 .003719 .000725 .001682 .0022008 .0055785 .0018591 .0044628
c K   0.00 .000109 .000246 .000049 .000111 .0000404 .0001002 .0000799 .0001877
c Ca  0.00 .001849 .004287 .002634 .006131 .0006931 .0017626 .0013607 .0032772
c Ti  0.00 .000074 .000204 .000138 .000384 .0000273 .0000829 .0000540 .0001555
c Cr  0.00 .000413 .001242 .000186 .000562 .0001546 .0005101 .0003038 .0009492
c Mn  0.00 .000280 .000889 .000126 .000402 .0001050 .0003659 .0002059 .0006798
c Fe  0.00 .026789 .086548 .012069 .039143 .0100475 .0356034 .0197181 .0661701
c Ni  0.00 .001537 .005218 .000723 .002465 .0005766 .0021477 .0011312 .0039899
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .113848 .229811 .095867 .174892 .0442956 .0985852 .0844701 .1773205
c    ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04hiCNONe.841962amet)
c
c  Z/X = 0.01983278    AGS04vhCNONe_OFe.5_W95          AGS04vhCNONe.2antimeteor
c         AGS04vhCNONe          ||     AGS04vhCNONe.5antimeteor    ||
c    ==================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +0.10 .263820 .185686 .118732 .083546 .3358885 .2605241 .2943424 .2156212
c N  +0.12 .067812 .055659 .030518 .025042 .0906599 .0820020 .0774886 .0661962
c O  +0.10 .491254 .460576 .699138 .655310 .4418255 .4564867 .4703199 .4589405
c Ne +0.10 .074376 .087948 .065260 .077148 .1012381 .1319220 .0857528 .1055376
c Na  0.00 .001590 .002142 .000716 .000964 .0004434 .0006583 .0011044 .0015485
c Mg  0.00 .028927 .041200 .032700 .046561 .0080606 .0126514 .0200899 .0297805
c Al  0.00 .002298 .003633 .001034 .001634 .0006406 .0011161 .0015959 .0026262
c Si  0.00 .027625 .045465 .024806 .040815 .0076973 .0139602 .0191852 .0328631
c P   0.00 .000214 .000389 .000096 .000174 .0000594 .0001189 .0001487 .0002810
c S   0.00 .012340 .023183 .011874 .022302 .0034384 .0071185 .0085700 .0167572
c Cl  0.00 .000145 .000301 .000065 .000135 .0000406 .0000930 .0001007 .0002178
c Ar +0.10 .001627 .003808 .000732 .001713 .0022142 .0057120 .0018755 .0045696
c K   0.00 .000098 .000225 .000044 .000101 .0000272 .0000687 .0000681 .0001625
c Ca  0.00 .001666 .003912 .002370 .005565 .0004637 .0012001 .0011566 .0028272
c Ti  0.00 .000066 .000186 .000123 .000345 .0000181 .0000559 .0000458 .0001339
c Cr  0.00 .000372 .001133 .000167 .000509 .0001032 .0003466 .0002581 .0008184
c Mn  0.00 .000252 .000811 .000114 .000367 .0000702 .0002489 .0001749 .0005862
c Fe  0.00 .024134 .078981 .010861 .035534 .0067250 .0242529 .0167609 .0570897
c Ni  0.00 .001384 .004762 .000650 .002235 .0003861 .0014637 .0009616 .0034427
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .102738 .210131 .086352 .158954 .0303880 .0690652 .0720963 .1537045
c    ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04vhCNONe.714584amet)
c
c------------------------------------------------------------------------------
c
c  The components of the metallicity for the CNO-varied mixes are given below.
c  Note that burning C to N increases Z slightly, burning O to N decreases Z
c  slightly, and burning CNO to Ne increases Z significantly; thus, although
c  the mass fraction <Xheavy> of elements heavier than Ne does not change, the
c  ratio <h> = <Xheavy>/Z differs between these CNO-varied mixes:
c
c           'GN93hz'        'GN93hz.CtoN'    'GN93hz.COtoN'   'GN93hz.CNOtoNe'
c     --------------------  ---------------  ---------------  ----------------
c           solar CNO        most C --> N    most C,O --> N   all C,N,O --> Ne
c     ====================  ===============  ===============  ================
c i   Ab_i  Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z  
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c C   8.55 .245518 .173285  .000246 .000169  .000246 .000179  .000000 .000000
c N   7.97 .064578 .053152  .309850 .247897  .817686 .694328  .000000 .000000
c O   8.87 .512966 .482273  .512966 .468789  .005130 .004976  .000000 .000000
c Ne  8.08 .083210 .098668  .083210 .095909  .083210 .101793  .906272 .847998
c Na  6.33 .001479 .001999  .001479 .001942  .001479 .002061  .001479 .001577
c Mg  7.58 .026308 .037573  .026308 .036523  .026308 .038764  .026308 .029650
c Al  6.47 .002042 .003238  .002042 .003147  .002042 .003340  .002042 .002555
c Si  7.55 .024552 .040520  .024552 .039387  .024552 .041803  .024552 .031975
c P   5.45 .000195 .000355  .000195 .000345  .000195 .000366  .000195 .000280
c S   7.21 .011222 .021142  .011222 .020550  .011222 .021811  .011222 .016683
c Cl  5.50 .000219 .000456  .000219 .000443  .000219 .000471  .000219 .000360
c Ar  6.52 .002291 .005379  .002291 .005228  .002291 .005548  .002291 .004244
c K   5.12 .000091 .000210  .000091 .000203  .000091 .000216  .000091 .000165
c Ca  6.36 .001586 .003734  .001586 .003631  .001586 .003854  .001586 .002948
c Ti  5.03 .000075 .000211  .000075 .000205  .000075 .000218  .000075 .000167
c Cr  5.68 .000329 .001005  .000329 .000977  .000329 .001037  .000329 .000793
c Mn  5.39 .000170 .000548  .000170 .000533  .000170 .000566  .000170 .000433
c Fe  7.50 .021877 .071794  .021877 .069787  .021877 .074068  .021877 .056653
c Ni  6.25 .001293 .004459  .001293 .004335  .001293 .004601  .001293 .003519
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c <h>      .093729 .192623  .093729 .187236  .093729 .198724  .093729 .152002
c     ====================  ===============  ===============  ================
c where  <h>  is the sum of everything heavier than Ne.
c
c  For the GS98 mix, the corresponding CNO-varied metallicity components are:
c
c            'GS98hz'        'GS98hz.CtoN'   'GS98hz.COtoN'   'GS98hz.CNOtoNe'
c     --------------------  ---------------  ---------------  ----------------
c           solar CNO        most C --> N    most C,O --> N   all C,N,O --> Ne
c     ====================  ===============  ===============  ================
c i   Ab_i  Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z  
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c C   8.52 .245825 .171836  .000246 .000167  .000246 .000177  .000000 .000000
c N   7.92 .061748 .050335  .307327 .243574  .804230 .675229  .000000 .000000
c O   8.83 .501922 .467356  .501922 .454393  .005019 .004813  .000000 .000000
c Ne  8.08 .089265 .104831  .089265 .101924  .089265 .107973  .898760 .836936
c Na  6.32 .001562 .002090  .001562 .002032  .001562 .002153  .001562 .001657
c Mg  7.58 .028224 .039924  .028224 .038816  .028224 .041120  .028224 .031657
c Al  6.49 .002294 .003603  .002294 .003502  .002294 .003710  .002294 .002856
c Si  7.56 .026954 .044057  .026954 .042835  .026954 .045377  .026954 .034935
c P   5.56 .000235 .000423  .000235 .000412  .000235 .000436  .000235 .000336
c S   7.20 .012602 .023513  .012602 .022861  .012602 .024218  .012602 .018645
c Cl  5.28 .000141 .000292  .000141 .000283  .000141 .000300  .000141 .000231
c Ar  6.40 .001865 .004335  .001865 .004216  .001865 .004466  .001865 .003438
c K   5.13 .000100 .000228  .000100 .000221  .000100 .000234  .000100 .000180
c Ca  6.35 .001670 .003896  .001670 .003787  .001670 .004012  .001670 .003089
c Ti  4.94 .000070 .000195  .000070 .000190  .000070 .000201  .000070 .000155
c Cr  5.69 .000369 .001117  .000369 .001086  .000369 .001150  .000369 .000885
c Mn  5.53 .000244 .000779  .000244 .000759  .000244 .000804  .000244 .000619
c Fe  7.50 .023517 .076433  .023517 .074315  .023517 .078726  .023517 .060608
c Ni  6.25 .001393 .004757  .001393 .004627  .001393 .004901  .001393 .003773
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c <h>      .101240 .205642  .101240 .199942  .101240 .211808  .101240 .163064
c     ====================  ===============  ===============  ================
c where  <h>  is the sum of everything heavier than Ne.
c
c  For the AGS04 mix, the corresponding CNO-varied metallicity components are:
c
c           'AGS04hz'       'AGS04hz.CtoN'  'AGS04hz.COtoN'  'AGS04hz.CNOtoNe'
c     --------------------  ---------------  ---------------  ----------------
c           solar CNO        most C --> N    most C,O --> N   all C,N,O --> Ne
c     ====================  ===============  ===============  ================
c i   Ab_i  Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z  
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c C   8.39 .257854 .176688  .002579 .001717  .002579 .001812  .000000 .000000
c N   7.78 .063296 .050578  .318571 .247373  .793915 .650653  .000000 .000000
c O   8.66 .480145 .438260  .480145 .425880  .004801 .004494  .000000 .000000
c Ne  7.84 .072700 .083693  .072700 .081329  .072700 .085836  .873995 .800479
c Na  6.27 .001956 .002565  .001956 .002493  .001956 .002631  .001956 .002041
c Mg  7.53 .035594 .049354  .035594 .047960  .035594 .050618  .035594 .039266
c Al  6.43 .002827 .004352  .002827 .004229  .002827 .004463  .002827 .003462
c Si  7.51 .033992 .054464  .033992 .052926  .033992 .055859  .033992 .043331
c P   5.40 .000264 .000466  .000264 .000453  .000264 .000478  .000264 .000371
c S   7.16 .015184 .027771  .015184 .026987  .015184 .028483  .015184 .022095
c Cl  5.23 .000178 .000361  .000178 .000350  .000178 .000369  .000178 .000286
c Ar  6.18 .001590 .003623  .001590 .003521  .001590 .003716  .001590 .002883
c K   5.06 .000121 .000269  .000121 .000262  .000121 .000277  .000121 .000215
c Ca  6.29 .002050 .004686  .002050 .004555  .002050 .004807  .002050 .003729
c Ti  4.89 .000082 .000223  .000082 .000218  .000082 .000230  .000082 .000178
c Cr  5.63 .000458 .001358  .000458 .001320  .000458 .001393  .000458 .001081
c Mn  5.47 .000310 .000972  .000310 .000944  .000310 .000996  .000310 .000773
c Fe  7.45 .029696 .094613  .029696 .091941  .029696 .097036  .029696 .075273
c Ni  6.19 .001703 .005704  .001703 .005542  .001703 .005849  .001703 .004537
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c <h>      .126005 .250781  .126005 .243701  .126005 .257205  .126005 .199521
c     ====================  ===============  ===============  ================
c where  <h>  is the sum of everything heavier than Ne.
c
c  For the high-C,N,O,Ne version of the "AGS04" mix:
c
c                        'AGS04hiCNONe.CtoN'            'AGS04hiCNONe.CNOtoNe'
c          'AGS04hiCNONe'         ||      'AGS04hiCNONe.COtoN'      ||
c     --------------------  ---------------  ---------------  ----------------
c           solar CNO        most C --> N    most C,O --> N   all C,N,O --> Ne
c     ====================  ===============  ===============  ================
c i   Ab_i  Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z  
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c C   8.44 .261002 .181349  .002610 .001761  .002610 .001861  .000000 .000000
c N   7.84 .065561 .053122  .323953 .254885  .805098 .669508  .000000 .000000
c O   8.71 .486005 .449821  .486005 .436791  .004860 .004616  .000000 .000000
c Ne  7.89 .073584 .085897  .073584 .083408  .073584 .088156  .886152 .818221
c Na  6.27 .001765 .002347  .001765 .002279  .001765 .002409  .001765 .001857
c Mg  7.53 .032110 .045147  .032110 .043839  .032110 .046335  .032110 .035711
c Al  6.43 .002551 .003981  .002551 .003866  .002551 .004086  .002551 .003149
c Si  7.51 .030665 .049822  .030665 .048378  .030665 .051132  .030665 .039408
c P   5.40 .000238 .000427  .000238 .000414  .000238 .000438  .000238 .000337
c S   7.16 .013698 .025404  .013698 .024669  .013698 .026073  .013698 .020095
c Cl  5.23 .000161 .000330  .000161 .000321  .000161 .000339  .000161 .000261
c Ar  6.23 .001609 .003719  .001609 .003611  .001609 .003816  .001609 .002941
c K   5.06 .000109 .000246  .000109 .000239  .000109 .000253  .000109 .000195
c Ca  6.29 .001849 .004287  .001849 .004163  .001849 .004400  .001849 .003391
c Ti  4.89 .000074 .000204  .000074 .000199  .000074 .000210  .000074 .000162
c Cr  5.63 .000413 .001242  .000413 .001206  .000413 .001275  .000413 .000983
c Mn  5.47 .000280 .000889  .000280 .000864  .000280 .000913  .000280 .000704
c Fe  7.45 .026789 .086548  .026789 .084039  .026789 .088823  .026789 .068457
c Ni  6.19 .001537 .005218  .001537 .005068  .001537 .005357  .001537 .004128
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c <h>      .113848 .229811  .113848 .223155  .113848 .235859  .113848 .181779
c     ====================  ===============  ===============  ================
c where  <h>  is the sum of everything heavier than Ne.
c
c  For the very-high-C,N,O,Ne version of the "AGS04" mix:
c
c                        'AGS04vhCNONe.CtoN'            'AGS04vhCNONe.CNOtoNe'
c          'AGS04vhCNONe'         ||      'AGS04vhCNONe.COtoN'      ||
c     --------------------  ---------------  ---------------  ----------------
c           solar CNO        most C --> N    most C,O --> N   all C,N,O --> Ne
c     ====================  ===============  ===============  ================
c i   Ab_i  Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z     Ni/Nz   Xi/Z  
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c C   8.49 .263820 .185686  .002638 .001802  .002638 .001907  .000000 .000000
c N   7.90 .067812 .055659  .328994 .262029  .815335 .687252  .000000 .000000
c O   8.76 .491254 .460576  .491254 .446925  .004913 .004730  .000000 .000000
c Ne  7.94 .074376 .087948  .074376 .085341  .074376 .090318  .897262 .834689
c Na  6.27 .001590 .002142  .001590 .002079  .001590 .002200  .001590 .001685
c Mg  7.53 .028927 .041200  .028927 .039978  .028927 .042310  .028927 .032412
c Al  6.43 .002298 .003633  .002298 .003526  .002298 .003731  .002298 .002858
c Si  7.51 .027625 .045465  .027625 .044117  .027625 .046690  .027625 .035768
c P   5.40 .000214 .000389  .000214 .000377  .000214 .000399  .000214 .000306
c S   7.16 .012340 .023183  .012340 .022496  .012340 .023808  .012340 .018238
c Cl  5.23 .000145 .000301  .000145 .000292  .000145 .000309  .000145 .000237
c Ar  6.28 .001627 .003808  .001627 .003696  .001627 .003911  .001627 .002996
c K   5.06 .000098 .000225  .000098 .000218  .000098 .000231  .000098 .000177
c Ca  6.29 .001666 .003912  .001666 .003797  .001666 .004018  .001666 .003078
c Ti  4.89 .000066 .000186  .000066 .000180  .000066 .000190  .000066 .000146
c Cr  5.63 .000372 .001133  .000372 .001100  .000372 .001164  .000372 .000892
c Mn  5.47 .000252 .000811  .000252 .000787  .000252 .000833  .000252 .000638
c Fe  7.45 .024134 .078981  .024134 .076640  .024134 .081110  .024134 .062135
c Ni  6.19 .001384 .004762  .001384 .004620  .001384 .004889  .001384 .003745
c --  ---- ------- -------  ------- -------  ------- -------  ------- -------
c <h>      .102738 .210131  .102738 .203903  .102738 .215793  .102738 .165311
c     ====================  ===============  ===============  ================
c where  <h>  is the sum of everything heavier than Ne.
c
c------------------------------------------------------------------------------
c
c  There are indications that Ne might have an abundance up to 3 times that
c  inferred from the observed Solar coronal Ne/O ratios, although there are
c  arguments against this too; at the very least, the Ne abundance may be quite
c  uncertain, so here are AGS04 mixes with Ne * 1.5, 2.0, 2.5, and 3.0:
c
c  Z/X = 0.01724878      AGS04x15Ne_OFe.5_W95
c            AGS04x15Ne         ||          AGS04x15Ne.5amet  AGS04x15Ne.2amet
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  0.000 .248810 .169591 .112709 .077488 .3184504 .2363816 .2781026 .1963072
c N  0.000 .061076 .048547 .027666 .022181 .0824077 .0713340 .0700487 .0576618
c O  0.000 .463305 .420657 .663672 .607789 .4011116 .3966082 .4371453 .4110377
c Ne +.176 .105225 .120496 .092932 .107340 .1449344 .1807440 .1219276 .1445952
c Na 0.000 .001887 .002462 .000855 .001125 .0008012 .0011383 .0014303 .0019325
c Mg 0.000 .034345 .047372 .039079 .054367 .0145862 .0219094 .0260341 .0371869
c Al 0.000 .002728 .004177 .001236 .001909 .0011587 .0019321 .0020679 .0032790
c Si 0.000 .032800 .052277 .029646 .047659 .0139299 .0241782 .0248626 .0410375
c P  0.000 .000255 .000448 .000116 .000206 .0001083 .0002074 .0001933 .0003518
c S  0.000 .014651 .026656 .014190 .026040 .0062221 .0123280 .0111057 .0209248
c Cl 0.000 .000172 .000346 .000077 .000156 .0000733 .0001605 .0001305 .0002718
c Ar 0.000 .001534 .003478 .000695 .001589 .0021132 .0052170 .0017777 .0041736
c K  0.000 .000116 .000258 .000052 .000116 .0000489 .0001182 .0000880 .0002021
c Ca 0.000 .001978 .004498 .002833 .006499 .0008394 .0020791 .0014988 .0035304
c Ti 0.000 .000079 .000214 .000148 .000406 .0000331 .0000979 .0000595 .0001675
c Cr 0.000 .000442 .001303 .000200 .000595 .0001872 .0006016 .0003346 .0010224
c Mn 0.000 .000299 .000933 .000136 .000428 .0001272 .0004319 .0002269 .0007326
c Fe 0.000 .028654 .090812 .012980 .041493 .0121689 .0419994 .0217199 .0712869
c Ni 0.000 .001644 .005475 .000778 .002614 .0006983 .0025332 .0012460 .0042983
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .121584 .240709 .103021 .185202 .0530959 .1149322 .0927758 .1903981
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04x15Ne.921257amet)
c
c  Z/X = 0.01794158      AGS04x2Ne_OFe.5_W95
c            AGS04x2Ne          ||          AGS04x2Ne.5amet   AGS04x2Ne.2amet
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  0.000 .240379 .163043 .109323 .074812 .3072900 .2265596 .2684938 .1884496
c N  0.000 .059006 .046672 .026835 .021415 .0796959 .0685215 .0676994 .0554118
c O  0.000 .447605 .404412 .643730 .586793 .3790228 .3722407 .4187884 .3915437
c Ne +.301 .135546 .154458 .120186 .138176 .1870455 .2316870 .1571847 .1853496
c Na 0.000 .001823 .002367 .000829 .001086 .0007056 .0009958 .0013536 .0018185
c Mg 0.000 .033182 .045543 .037906 .052491 .0128463 .0191659 .0246373 .0349921
c Al 0.000 .002636 .004016 .001199 .001843 .0010207 .0016906 .0019571 .0030858
c Si 0.000 .031688 .050258 .028755 .046012 .0122678 .0211497 .0235282 .0386147
c P  0.000 .000246 .000430 .000112 .000198 .0000949 .0001804 .0001824 .0003302
c S  0.000 .014155 .025626 .013764 .025141 .0054793 .0107830 .0105093 .0196888
c Cl 0.000 .000166 .000333 .000075 .000151 .0000648 .0001410 .0001237 .0002562
c Ar 0.000 .001482 .003344 .000674 .001534 .0020455 .0050160 .0017190 .0040128
c K  0.000 .000112 .000248 .000051 .000114 .0000430 .0001032 .0000832 .0001901
c Ca 0.000 .001911 .004324 .002748 .006275 .0007390 .0018181 .0014182 .0033216
c Ti 0.000 .000076 .000206 .000143 .000390 .0000292 .0000859 .0000564 .0001579
c Cr 0.000 .000427 .001253 .000194 .000575 .0001650 .0005266 .0003167 .0009624
c Mn 0.000 .000289 .000897 .000132 .000413 .0001121 .0003779 .0002147 .0006894
c Fe 0.000 .027683 .087306 .012590 .040059 .0107174 .0367404 .0205546 .0670797
c Ni 0.000 .001588 .005264 .000754 .002522 .0006152 .0022167 .0011793 .0040451
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .117464 .231415 .099926 .178804 .0469458 .1009912 .0878337 .1792453
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04x2Ne.856526amet)
c
c  Z/X = 0.01863439      AGS04x25Ne_OFe.5_W95
c            AGS04x25Ne         ||          AGS04x25Ne.5amet  AGS04x25Ne.2amet
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  0.000 .232500 .156981 .106134 .072313 .2968211 .2174666 .2594992 .1811752
c N  0.000 .057072 .044937 .026052 .020700 .0771536 .0659190 .0655014 .0533298
c O  0.000 .432932 .389378 .624950 .567196 .3583114 .3496897 .4016121 .3735029
c Ne +.398 .163879 .185894 .145851 .166953 .2265366 .2788410 .1901794 .2230728
c Na 0.000 .001764 .002279 .000805 .001050 .0006160 .0008638 .0012818 .0017129
c Mg 0.000 .032094 .043849 .036800 .050737 .0112136 .0166249 .0233291 .0329593
c Al 0.000 .002549 .003867 .001164 .001782 .0008914 .0014671 .0018535 .0029070
c Si 0.000 .030650 .048389 .027916 .044475 .0107089 .0183462 .0222792 .0363719
c P  0.000 .000238 .000414 .000109 .000192 .0000828 .0001564 .0001727 .0003110
c S  0.000 .013691 .024674 .013362 .024301 .0047837 .0093550 .0099520 .0185464
c Cl 0.000 .000161 .000321 .000073 .000147 .0000569 .0001230 .0001173 .0002418
c Ar 0.000 .001434 .003219 .000655 .001484 .0019815 .0048285 .0016635 .0038628
c K  0.000 .000109 .000239 .000050 .000111 .0000376 .0000897 .0000789 .0001793
c Ca 0.000 .001848 .004164 .002667 .006064 .0006455 .0015781 .0013433 .0031296
c Ti 0.000 .000074 .000198 .000140 .000380 .0000253 .0000739 .0000533 .0001483
c Cr 0.000 .000413 .001206 .000189 .000557 .0001438 .0004561 .0002998 .0009060
c Mn 0.000 .000280 .000863 .000128 .000399 .0000975 .0003269 .0002031 .0006486
c Fe 0.000 .026776 .084060 .012223 .038722 .0093558 .0318714 .0194638 .0631845
c Ni 0.000 .001536 .005068 .000732 .002437 .0005370 .0019227 .0011166 .0038099
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .113617 .222810 .097013 .172838 .0411773 .0880837 .0832079 .1689193
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04x25Ne.797451amet)
c
c  Z/X = 0.01932720      AGS04x3Ne_OFe.5_W95
c            AGS04x3Ne          ||          AGS04x3Ne.5amet   AGS04x3Ne.2amet
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  0.000 .225122 .151354 .103126 .069977 .2869847 .2090261 .2510645 .1744228
c N  0.000 .055261 .043326 .025314 .020031 .0747640 .0635025 .0634395 .0513966
c O  0.000 .419197 .375420 .607243 .548880 .3388465 .3287527 .3855011 .3567533
c Ne +.477 .190413 .215077 .170059 .193870 .2636471 .3226155 .2211244 .2580924
c Na 0.000 .001708 .002198 .000783 .001017 .0005325 .0007423 .0012150 .0016157
c Mg 0.000 .031075 .042278 .035756 .049097 .0096809 .0142684 .0221037 .0310741
c Al 0.000 .002468 .003728 .001131 .001724 .0007692 .0012586 .0017558 .0027402
c Si 0.000 .029677 .046655 .027125 .043039 .0092449 .0157452 .0211086 .0342911
c P  0.000 .000230 .000399 .000105 .000184 .0000713 .0001339 .0001635 .0002930
c S  0.000 .013256 .023789 .012983 .023515 .0041291 .0080275 .0094286 .0174844
c Cl 0.000 .000156 .000309 .000071 .000142 .0000488 .0001050 .0001109 .0002274
c Ar 0.000 .001388 .003104 .000636 .001435 .0019220 .0046560 .0016120 .0037248
c K  0.000 .000105 .000230 .000048 .000106 .0000321 .0000762 .0000745 .0001685
c Ca 0.000 .001789 .004014 .002591 .005867 .0005567 .0013531 .0012723 .0029496
c Ti 0.000 .000071 .000191 .000135 .000365 .0000218 .0000634 .0000505 .0001399
c Cr 0.000 .000400 .001163 .000183 .000538 .0001242 .0003916 .0002841 .0008544
c Mn 0.000 .000271 .000832 .000124 .000385 .0000842 .0002804 .0001924 .0006114
c Fe 0.000 .025926 .081047 .011876 .037470 .0080765 .0273519 .0184408 .0595689
c Ni 0.000 .001487 .004886 .000711 .002358 .0004635 .0016497 .0010578 .0035915
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .110007 .214823 .094258 .167242 .0357577 .0761032 .0788705 .1593349
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04x3Ne.747866amet)
c
c  Z/X = 0.01887595    AGS04hiCNOx15Ne_OFe.5_W95         AGS04hiCNOx15Ne.2amet
c         AGS04hiCNOx15Ne       ||       AGS04hiCNOx15Ne.5amet     ||
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +.050 .251740 .173881 .113904 .079026 .3212059 .2428166 .2810428 .2014552
c N  +.060 .063234 .050934 .028611 .023148 .0849795 .0749145 .0724070 .0605262
c O  +.050 .468761 .431300 .670709 .619856 .4097142 .4125727 .4438537 .4238093
c Ne +.226 .106459 .123540 .093912 .109465 .1459095 .1853100 .1231012 .1482480
c Na 0.000 .001702 .002250 .000770 .001023 .0005669 .0008203 .0012231 .0016781
c Mg 0.000 .030971 .043288 .035199 .049417 .0103179 .0157834 .0222584 .0322861
c Al 0.000 .002460 .003817 .001113 .001735 .0008198 .0013921 .0017680 .0028470
c Si 0.000 .029577 .047770 .026702 .043319 .0098536 .0174177 .0212567 .0356291
c P  0.000 .000230 .000409 .000104 .000186 .0000764 .0001489 .0001650 .0003050
c S  0.000 .013211 .024358 .012780 .023667 .0044013 .0088810 .0094951 .0181672
c Cl 0.000 .000155 .000316 .000070 .000143 .0000518 .0001155 .0001114 .0002358
c Ar +.050 .001552 .003566 .000702 .001620 .0021275 .0053490 .0017949 .0042792
c K  0.000 .000105 .000236 .000047 .000106 .0000346 .0000852 .0000753 .0001757
c Ca 0.000 .001783 .004110 .002551 .005906 .0005935 .0014971 .0012813 .0030648
c Ti 0.000 .000071 .000195 .000133 .000368 .0000230 .0000694 .0000506 .0001447
c Cr 0.000 .000398 .001191 .000180 .000541 .0001325 .0004336 .0002862 .0008880
c Mn 0.000 .000270 .000852 .000122 .000387 .0000898 .0003104 .0001938 .0006354
c Fe 0.000 .025839 .082984 .011691 .037714 .0086083 .0302574 .0185702 .0618933
c Ni 0.000 .001482 .005003 .000700 .002373 .0004940 .0018252 .0010653 .0037319
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .109806 .220345 .092864 .168505 .0381909 .0843862 .0795953 .1659613
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04hiCNOx15Ne.775992amet)
c
c  Z/X = 0.01965326    AGS04hiCNOx2Ne_OFe.5_W95           AGS04hiCNOx2Ne.2amet
c         AGS04hiCNOx2Ne        ||        AGS04hiCNOx2Ne.5amet     ||
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +.050 .243112 .167004 .110446 .076243 .3098835 .2325011 .2712458 .1932028
c N  +.060 .061067 .048920 .027742 .022333 .0821687 .0718935 .0699583 .0581094
c O  +.050 .452697 .414238 .650349 .598029 .3872014 .3869797 .4250999 .4033349
c Ne +.351 .137081 .158205 .121416 .140815 .1882627 .2373075 .1586465 .1898460
c Na 0.000 .001644 .002161 .000747 .000987 .0004782 .0006868 .0011525 .0015713
c Mg 0.000 .029909 .041576 .034130 .047677 .0087044 .0132154 .0209747 .0302317
c Al 0.000 .002376 .003666 .001079 .001673 .0006916 .0011656 .0016661 .0026658
c Si 0.000 .028563 .045881 .025891 .041793 .0083129 .0145842 .0200310 .0333623
c P  0.000 .000222 .000393 .000101 .000180 .0000646 .0001249 .0001556 .0002858
c S  0.000 .012759 .023394 .012393 .022836 .0037125 .0074350 .0089470 .0170104
c Cl 0.000 .000150 .000304 .000068 .000139 .0000440 .0000975 .0001053 .0002214
c Ar +.050 .001499 .003425 .000681 .001564 .0020588 .0051375 .0017349 .0041100
c K  0.000 .000101 .000227 .000046 .000103 .0000294 .0000717 .0000711 .0001649
c Ca 0.000 .001722 .003948 .002473 .005697 .0005009 .0012541 .0012077 .0028704
c Ti 0.000 .000069 .000188 .000130 .000358 .0000197 .0000589 .0000480 .0001363
c Cr 0.000 .000385 .001144 .000175 .000523 .0001118 .0003631 .0002697 .0008316
c Mn 0.000 .000260 .000819 .000118 .000373 .0000760 .0002609 .0001829 .0005958
c Fe 0.000 .024953 .079702 .011336 .036386 .0072621 .0253344 .0174992 .0579549
c Ni 0.000 .001431 .004805 .000679 .002291 .0004168 .0015282 .0010038 .0034943
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .106043 .211633 .090047 .162580 .0324837 .0713182 .0750495 .1555069
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04hiCNOx2Ne.727860amet)
c
c  Z/X = 0.02043057    AGS04hiCNOx25Ne_OFe.5_W95         AGS04hiCNOx25Ne.2amet
c         AGS04hiCNOx25Ne       ||       AGS04hiCNOx25Ne.5amet     ||
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +.050 .235057 .160650 .107192 .073650 .2992678 .2229701 .2620815 .1855780
c N  +.060 .059044 .047059 .026925 .021574 .0795330 .0691020 .0676675 .0558762
c O  +.050 .437697 .398479 .631190 .577693 .3661031 .3633412 .4075643 .3844241
c Ne +.448 .165674 .190232 .147299 .170033 .2279647 .2853480 .1918908 .2282784
c Na 0.000 .001589 .002079 .000725 .000953 .0003954 .0005638 .0010867 .0014729
c Mg 0.000 .028918 .039994 .033124 .046055 .0071915 .0108424 .0197738 .0283333
c Al 0.000 .002297 .003527 .001047 .001616 .0005719 .0009571 .0015710 .0024990
c Si 0.000 .027617 .044135 .025128 .040371 .0068680 .0119652 .0188840 .0312671
c P  0.000 .000214 .000378 .000098 .000174 .0000533 .0001024 .0001467 .0002678
c S  0.000 .012336 .022504 .012028 .022059 .0030673 .0061000 .0084349 .0159424
c Cl 0.000 .000145 .000292 .000066 .000134 .0000361 .0000795 .0000990 .0002070
c Ar +.050 .001449 .003295 .000661 .001511 .0019945 .0049425 .0016789 .0039540
c K  0.000 .000098 .000218 .000045 .000101 .0000240 .0000582 .0000669 .0001541
c Ca 0.000 .001665 .003798 .002401 .005505 .0004139 .0010291 .0011386 .0026904
c Ti 0.000 .000066 .000181 .000125 .000343 .0000163 .0000484 .0000453 .0001279
c Cr 0.000 .000372 .001100 .000170 .000506 .0000921 .0002971 .0002541 .0007788
c Mn 0.000 .000252 .000787 .000115 .000361 .0000625 .0002129 .0001721 .0005574
c Fe 0.000 .024126 .076670 .011002 .035148 .0060003 .0207864 .0164976 .0543165
c Ni 0.000 .001384 .004622 .000659 .002213 .0003443 .0012537 .0009463 .0032747
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .102528 .203580 .087394 .157050 .0271314 .0592387 .0707959 .1458433
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04hiCNOx25Ne.682227amet)
c
c  Z/X = 0.02120788    AGS04hiCNOx3Ne_OFe.5_W95           AGS04hiCNOx3Ne.2amet
c         AGS04hiCNOx3Ne        ||        AGS04hiCNOx3Ne.5amet     ||
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +.050 .227518 .154762 .104125 .071229 .2892973 .2141381 .2534926 .1785124
c N  +.060 .057150 .045334 .026155 .020865 .0770566 .0665145 .0655198 .0538062
c O  +.050 .423658 .383873 .613128 .558696 .3462824 .3414322 .3911257 .3668969
c Ne +.527 .192433 .219912 .171701 .197330 .2652590 .3298680 .2230522 .2638944
c Na 0.000 .001538 .002003 .000704 .000922 .0003175 .0004498 .0010251 .0013817
c Mg 0.000 .027991 .038528 .032177 .044541 .0057706 .0086434 .0186483 .0265741
c Al 0.000 .002223 .003397 .001017 .001563 .0004583 .0007621 .0014811 .0023430
c Si 0.000 .026731 .042518 .024409 .039044 .0055117 .0095397 .0178097 .0293267
c P  0.000 .000207 .000364 .000095 .000168 .0000426 .0000814 .0001382 .0002510
c S  0.000 .011940 .021679 .011683 .021332 .0024611 .0048625 .0079547 .0149524
c Cl 0.000 .000140 .000282 .000064 .000129 .0000295 .0000645 .0000938 .0001950
c Ar +.050 .001403 .003174 .000642 .001461 .0019339 .0047610 .0016262 .0038088
c K  0.000 .000095 .000210 .000043 .000096 .0000192 .0000462 .0000630 .0001445
c Ca 0.000 .001612 .003658 .002332 .005323 .0003316 .0008191 .0010734 .0025224
c Ti 0.000 .000064 .000174 .000121 .000330 .0000128 .0000379 .0000426 .0001195
c Cr 0.000 .000360 .001060 .000165 .000489 .0000740 .0002371 .0002397 .0007308
c Mn 0.000 .000244 .000759 .000112 .000350 .0000505 .0001709 .0001626 .0005238
c Fe 0.000 .023353 .073860 .010687 .033992 .0048149 .0165714 .0155587 .0509445
c Ni 0.000 .001340 .004453 .000640 .002140 .0002765 .0010002 .0008926 .0030719
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .099241 .196119 .084891 .151880 .0221047 .0480472 .0668097 .1368901
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04hiCNOx3Ne.639022amet)
c
c  Z/X = 0.02070490    AGS04vhCNOx15Ne_OFe.5_W95         AGS04vhCNOx15Ne.2amet
c         AGS04vhCNOx15Ne       ||       AGS04vhCNOx15Ne.5amet     ||
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +.100 .254360 .177864 .114980 .080443 .3236246 .2487911 .2836549 .2062348
c N  +.120 .065381 .053315 .029554 .024112 .0875472 .0784860 .0747562 .0633834
c O  +.100 .473639 .441177 .677043 .630963 .4173540 .4273882 .4498350 .4356617
c Ne +.276 .107564 .126365 .094797 .111424 .1467589 .1895475 .1241412 .1516380
c Na 0.000 .001533 .002051 .000693 .000928 .0003546 .0005218 .0010342 .0014393
c Mg 0.000 .027890 .039464 .031667 .044832 .0064587 .0100474 .0188256 .0276973
c Al 0.000 .002215 .003480 .001001 .001573 .0005134 .0008866 .0014955 .0024426
c Si 0.000 .026635 .043550 .024023 .039300 .0061680 .0110877 .0179784 .0305651
c P  0.000 .000207 .000373 .000094 .000170 .0000479 .0000949 .0001396 .0002618
c S  0.000 .011897 .022206 .011498 .021472 .0027549 .0056530 .0080305 .0155848
c Cl 0.000 .000140 .000289 .000063 .000130 .0000331 .0000750 .0000948 .0002034
c Ar +.100 .001568 .003648 .000709 .001650 .0021401 .0054720 .0018103 .0043776
c K  0.000 .000095 .000215 .000043 .000098 .0000215 .0000537 .0000636 .0001505
c Ca 0.000 .001606 .003747 .002295 .005358 .0003713 .0009526 .0010837 .0026292
c Ti 0.000 .000064 .000178 .000120 .000335 .0000143 .0000439 .0000429 .0001243
c Cr 0.000 .000359 .001086 .000162 .000491 .0000830 .0002761 .0002421 .0007620
c Mn 0.000 .000243 .000777 .000110 .000352 .0000563 .0001979 .0001640 .0005454
c Fe 0.000 .023269 .075654 .010518 .034215 .0053889 .0192624 .0157065 .0530973
c Ni 0.000 .001335 .004561 .000630 .002154 .0003093 .0011622 .0009010 .0032015
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .099056 .201279 .083626 .153058 .0247153 .0557872 .0676127 .1430821
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04vhCNOx15Ne.663458amet)
c
c  Z/X = 0.02157703    AGS04vhCNOx2Ne_OFe.5_W95           AGS04vhCNOx2Ne.2amet
c         AGS04vhCNOx2Ne        ||        AGS04vhCNOx2Ne.5amet     ||
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +.100 .245556 .170675 .111458 .077562 .3121591 .2380076 .2736893 .1976080
c N  +.120 .063118 .051160 .028649 .023249 .0846360 .0752535 .0722074 .0607974
c O  +.100 .457245 .423344 .656303 .608366 .3944695 .4006387 .4307287 .4142621
c Ne +.401 .138454 .161677 .122524 .143245 .1893233 .2425155 .1599419 .1940124
c Na 0.000 .001480 .001968 .000672 .000895 .0002722 .0003973 .0009694 .0013397
c Mg 0.000 .026925 .037869 .030698 .043228 .0049614 .0076549 .0176472 .0257833
c Al 0.000 .002139 .003339 .000971 .001518 .0003942 .0006751 .0014017 .0022734
c Si 0.000 .025713 .041790 .023287 .037893 .0047383 .0084477 .0168531 .0284531
c P  0.000 .000200 .000358 .000091 .000163 .0000368 .0000724 .0001309 .0002438
c S  0.000 .011486 .021309 .011147 .020705 .0021165 .0043075 .0075282 .0145084
c Cl 0.000 .000135 .000277 .000061 .000125 .0000253 .0000570 .0000887 .0001890
c Ar +.100 .001514 .003500 .000687 .001590 .0020703 .0052500 .0017490 .0042000
c K  0.000 .000091 .000206 .000041 .000093 .0000162 .0000402 .0000594 .0001397
c Ca 0.000 .001550 .003596 .002224 .005164 .0002854 .0007261 .0010161 .0024480
c Ti 0.000 .000062 .000171 .000117 .000325 .0000110 .0000334 .0000403 .0001159
c Cr 0.000 .000346 .001042 .000157 .000473 .0000637 .0002101 .0002269 .0007092
c Mn 0.000 .000235 .000746 .000107 .000341 .0000434 .0001514 .0001539 .0005082
c Fe 0.000 .022463 .072596 .010196 .032990 .0041396 .0146754 .0147232 .0494277
c Ni 0.000 .001288 .004377 .000610 .002075 .0002378 .0008862 .0008447 .0029807
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .095627 .193144 .081066 .147578 .0194121 .0435847 .0634327 .1333201
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04vhCNOx2Ne.621160amet)
c
c  Z/X = 0.02244915    AGS04vhCNOx25Ne_OFe.5_W95         AGS04vhCNOx25Ne.2amet
c         AGS04vhCNOx25Ne       ||       AGS04vhCNOx25Ne.5amet     ||
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +.100 .237341 .164045 .108145 .074880 .3014154 .2280626 .2643742 .1896520
c N  +.120 .061006 .049172 .027797 .022445 .0819071 .0722715 .0698241 .0584118
c O  +.100 .441949 .406897 .636799 .587335 .3730252 .3759682 .4128692 .3945257
c Ne +.498 .167278 .194245 .148603 .172865 .2292092 .2913675 .1934070 .2330940
c Na 0.000 .001430 .001892 .000652 .000864 .0001956 .0002833 .0009093 .0012485
c Mg 0.000 .026024 .036398 .029785 .041732 .0035585 .0054484 .0165456 .0240181
c Al 0.000 .002067 .003210 .000942 .001465 .0002833 .0004816 .0013147 .0021186
c Si 0.000 .024853 .040167 .022595 .036583 .0033987 .0060132 .0158014 .0265055
c P  0.000 .000193 .000344 .000088 .000157 .0000263 .0000514 .0001227 .0002270
c S  0.000 .011101 .020481 .010815 .019988 .0015178 .0030655 .0070581 .0135148
c Cl 0.000 .000130 .000266 .000059 .000121 .0000181 .0000405 .0000830 .0001758
c Ar +.100 .001463 .003364 .000667 .001536 .0020051 .0050460 .0016919 .0040368
c K  0.000 .000088 .000198 .000040 .000090 .0000114 .0000282 .0000557 .0001301
c Ca 0.000 .001498 .003456 .002158 .004986 .0002044 .0005161 .0009525 .0022800
c Ti 0.000 .000060 .000164 .000113 .000312 .0000076 .0000229 .0000376 .0001075
c Cr 0.000 .000335 .001001 .000153 .000459 .0000454 .0001486 .0002125 .0006600
c Mn 0.000 .000227 .000717 .000104 .000329 .0000312 .0001079 .0001443 .0004734
c Fe 0.000 .021712 .069776 .009893 .031850 .0029690 .0104454 .0138042 .0460437
c Ni 0.000 .001245 .004207 .000592 .002003 .0001707 .0006312 .0007920 .0027767
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .092426 .185641 .078656 .142475 .0144431 .0323302 .0595255 .1243165
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04vhCNOx25Ne.580960amet)
c
c  Z/X = 0.02332128    AGS04vhCNOx3Ne_OFe.5_W95           AGS04vhCNOx3Ne.2amet
c         AGS04vhCNOx3Ne        ||        AGS04vhCNOx3Ne.5amet     ||
c    ===================== =============== ================= =================
c i d:Ab_i  Ni/Nz   Xi/Z    Ni/Nz   Xi/Z     Ni/Nz    Xi/Z     Ni/Nz    Xi/Z
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c C  +.100 .229658 .157910 .105024 .072378 .2913253 .2188601 .2556460 .1822900
c N  +.120 .059031 .047333 .026995 .021695 .0793452 .0695130 .0675919 .0562050
c O  +.100 .427642 .391682 .618420 .567711 .3528913 .3531457 .3961398 .3762677
c Ne +.577 .194235 .224377 .173177 .200507 .2666617 .3365655 .2247580 .2692524
c Na 0.000 .001384 .001821 .000633 .000835 .0001230 .0001768 .0008523 .0011633
c Mg 0.000 .025181 .035037 .028925 .040337 .0022411 .0034069 .0155137 .0223849
c Al 0.000 .002000 .003090 .000915 .001417 .0001787 .0003016 .0012327 .0019746
c Si 0.000 .024048 .038665 .021942 .035359 .0021405 .0037602 .0148158 .0247031
c P  0.000 .000187 .000331 .000086 .000153 .0000165 .0000319 .0001150 .0002114
c S  0.000 .010742 .019715 .010503 .019320 .0009557 .0019165 .0066178 .0125956
c Cl 0.000 .000126 .000256 .000057 .000116 .0000115 .0000255 .0000778 .0001638
c Ar +.100 .001416 .003238 .000648 .001485 .0019439 .0048570 .0016384 .0038856
c K  0.000 .000085 .000191 .000039 .000087 .0000072 .0000177 .0000524 .0001217
c Ca 0.000 .001450 .003327 .002096 .004820 .0001287 .0003226 .0008932 .0021252
c Ti 0.000 .000058 .000158 .000110 .000302 .0000046 .0000139 .0000353 .0001003
c Cr 0.000 .000324 .000964 .000148 .000442 .0000286 .0000931 .0001994 .0006156
c Mn 0.000 .000219 .000690 .000100 .000315 .0000196 .0000674 .0001352 .0004410
c Fe 0.000 .021009 .067166 .009607 .030784 .0018695 .0065304 .0129429 .0429117
c Ni 0.000 .001205 .004049 .000575 .001937 .0001074 .0003942 .0007424 .0025871
c -- ----- ------- ------- ------- ------- -------- -------- -------- --------
c h>       .089434 .178698 .076384 .137709 .0097765 .0219157 .0558643 .1159849
c     ==================== =============== ================= =================
c  (NOTE: some abundances would go negative beyond AGS04vhCNOx3Ne.548057amet)
c
c------------------------------------------------------------------------------
c  OPAL ATOMIC MASSES:  We list the OPAL atomic masses (atomic weights) used
c  to convert number fractions (Ni) to mass fractions (X, Y, Z, Xi).
c
c  Element  Mass (a.u.)    Element  Mass (a.u.)    Element  Mass (a.u.)
c  -------  -----------    -------  -----------    -------  -----------
c   1  H       1.00790     12  Mg     24.30500     19  K      39.09830
c   2  He      4.00260     13  Al     26.98154     20  Ca     40.08000
c   6  C      12.01100     14  Si     28.08550     22  Ti     47.90000
c   7  N      14.00670     15  P      30.97376     24  Cr     51.99600
c   8  O      15.99940     16  S      32.06000     25  Mn     54.93800
c  10  Ne     20.17900     17  Cl     35.45300     26  Fe     55.84700
c  11  Na     22.98977     18  Ar     39.94800     28  Ni     58.70000
c------------------------------------------------------------------------------
c
c
c         +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c         Details of the accuracy of the X-, Z-, and CO-interpolation
c         +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c  Z-interpolation errors if 'GN93hz' file not used:
c  =================================================
c
c  For the non-CO-rich mixes (C=O=0.0), one can check the accuracy of the
c  Z-interpolation among the 'Gz???.x??' files when opacities are read in, by
c  looking at the 'GN93hz' opacities.  Where the Z values are in both files,
c  the opacities are identical.  When only 'GN93hz' (or only the 'Gz???.x??'
c  files) contains the Z value, errors in interpolation among 'Gz???.x??' files
c  are shown below; the largest, the mean, and the rms error in logKappa are
c  given (at T6 of 0.01 or higher, and all log R values).  Note that the
c  'Gz???.x??' files contain Z = 0.05, but 'GN93hz' does not; for this case,
c  interpolation in 'GN93hz' is tested, rather than interpolation among
c  'Gz???.x??' files.  Note that the Z-interpolation errors tend to be quite
c  small, with an rms error of less than 4% even in the worst case; applying
c  the 'GN93hz' opacity-shifts (as is the default) when interpolating in Z
c  should significantly reduce these errors (note: T6 < 0.01 omitted):
c
c  Z-interpolation errors if 'GN93hz' file not used (if khighz=0 in READZEXCO):
c  ----------------------------------------------------------------------------
c
c       dLogKappa(X=0.00) dLogKappa(X=0.10) dLogKappa(X=0.35) dLogKappa(X=0.70)
c       ================= ================= ================= =================
c   Z     max  mean   rms   max  mean   rms   max  mean   rms   max  mean   rms
c -----  ---- ----- -----  ---- ----- -----  ---- ----- -----  ---- ----- -----
c .0001  .128 .0078 .0169  .042 .0047 .0084  .040 .0041 .0077  .039 .0040 .0078
c .0003  .112 .0072 .0151  .045 .0046 .0084  .043 .0041 .0079  .046 .0040 .0081
c .002  -.036-.0018 .0038 -.012-.0012 .0023 -.012-.0011 .0022 -.013-.0010 .0025
c .04   -.003 .0000 .0003 -.001 .0000 .0002  .001 .0000 .0002  .001 .0000 .0002
c .05 * -.003 .0000 .0003  .001 .0000 .0002  .001 .0000 .0002  .001 .0000 .0002
c .06   -.004 .0000 .0004 -.001 .0000 .0003  .001 .0000 .0003 -.001 .0000 .0003
c .08   -.003 .0000 .0004 -.001 .0000 .0003  .001 .0000 .0003 -.001 .0000 .0003
c
c  It is clear from the following table that X-interpolation errors in the file
c  'GN93hz' (to get X=0.03) would be much larger than any Z-interpolation error
c  in the files Gz???.x03 ; thus any opacity shifts for X=0.03 are interpolated
c  from the X=0, X=0.1, and X=0.35 opacity shifts (unless only a single mix is
c  being read in, which is NOT the default case).  The size of the error in
c  these X-interpolated opacity shifts is presumably somewhat smaller than the
c  opacity shifts themselves, which in turn are smaller than the errors shown
c  below that would result if the 'GN93hz' opacities were interpolated in X to
c  get the X=0.03 opacities.
c
c
c  X-interpolation errors at X=0.03 if ONLY the 'GN93hz' file were used:
c  =====================================================================
c
c  X interpolation errors, for X = 0.03, interpolating in X = 0.0, 0.1, 0.2
c  in the file 'GN93hz' (note that a value of Xdel = 0.005 was used for this
c  interpolation, and all T6 < 0.01 opacities were omitted):
c
c  X-interpolation errors that would occur if 'Gz???.x??' files were not used:
c  ---------------------------------------------------------------------------
c
c     Z:    0.     0.001   0.004   0.01    0.02    0.03    0.1    (at X=0.03)
c         ------  ------  ------  ------  ------  ------  ------
c    max  -.3514  -.2971  -.2454  -.1913  -.1396  -.1062  -.0614  (dLogKappa)
c   mean  -.0159  -.0149  -.0141  -.0132  -.0124  -.0118  -.0103
c    rms   .0399   .0350   .0305   .0259   .0219   .0196   .0158
c
c
c  X-interpolation/extrapolation errors if 'GN93hz' file not used:
c  ===============================================================
c
c  The file 'GN93hz' contains (non-CO-rich) opacities at X-values not available
c  from the 'Gz???.x??' files, namely, X = 0.2, 0.5, 0.8, 0.9, 0.95, and 1-Z.
c  If one sets  khighz = 0  in the call to READZEXCO that reads the opacities,
c  then the 'GN93hz' file is not read in and X-interpolation is less accurate
c  [or alternatively, if one turns off "accurate-X" by calling  SET_XHI( 0 ) ].
c  For X < 0.75 or so, the errors are comparable to or smaller than the errors
c  from the original OPAL opacity computation; but for extrapolation to larger
c  X-values, the error grows very rapidly, and can become as large as an order
c  of magnitude as X approaches 1-Z:
c
c  X-interpolation/extrapolation errors if 'GN93hz' file not used (khighz=0):
c  --------------------------------------------------------------------------
c
c ***Interpolation (dLogKappa):
c      Z:   0.   0.0001  0.001  0.004  0.01   0.02   0.03   0.05   0.08   0.1
c X=0.2:  ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
c    max  -.0146  .0375 -.0153 -.0147 -.0139 -.0137 -.0142 -.0129 -.0124 -.0126
c   mean  -.0023 -.0017 -.0021 -.0018 -.0016 -.0014 -.0013 -.0012 -.0010 -.0010
c    rms   .0044  .0051  .0040  .0036  .0033  .0031  .0029  .0027  .0025  .0024
c X=0.5:  ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
c    max   .0291  .0291  .0284  .0269  .0260  .0249  .0244  .0243  .0234  .0234
c   mean   .0028  .0027  .0023  .0019  .0016  .0013  .0011  .0010  .0008  .0008
c    rms   .0076  .0073  .0066  .0059  .0053  .0048  .0045  .0042  .0039  .0038
c         ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
c ***Extrapolation (dLogKappa):
c      Z:   0.   0.0001  0.001  0.004  0.01   0.02   0.03   0.05   0.08   0.1
c X=0.8:  ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
c    max  -.0732 -.0721 -.0706 -.0680 -.0637 -.0620 -.0597 -.0578 -.0557 -.0565
c   mean  -.0071 -.0068 -.0059 -.0049 -.0041 -.0035 -.0031 -.0027 -.0024 -.0023
c    rms   .0178  .0172  .0153  .0134  .0119  .0107  .0100  .0092  .0086  .0084
c X=0.9:  ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
c    max  -.2415 -.2405 -.2328 -.2220 -.2063 -.1980 -.1914 -.1854 -.1828 -.1860
c   mean  -.0226 -.0216 -.0186 -.0154 -.0129 -.0110 -.0099 -.0088 -.0082 -.0085
c    rms   .0565  .0544  .0480  .0416  .0366  .0328  .0306  .0284  .0273  .0281
c X=0.95: ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
c    max  -.4256 -.4189 -.4025 -.3805 -.3555 -.3321 -.3264 -.3213
c   mean  -.0377 -.0360 -.0307 -.0253 -.0212 -.0181 -.0165 -.0154
c    rms   .0950  .0910  .0797  .0684  .0600  .0537  .0505  .0486
c X=1-Z:  ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
c    max  -.9901 -.9632 -.8694 -.7293 -.6045 -.4773 -.4059 -.3213 -.2219 -.1860
c   mean  -.0818 -.0758 -.0609 -.0468 -.0370 -.0306 -.0279 -.0154 -.0175 -.0085
c    rms   .2079  .1941  .1592  .1249  .0982  .0769  .0645  .0486  .0356  .0281
c         ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
c
c
c  CO-interpolation errors:
c  ========================
c
c     Note that there are six cases (at three different metallicities) where
c  mixes on the line C+O = 1-X-Z, with identical compositions, are interpolated
c  in two different ways when being read into two different positions in the
c  matrix CO; since these cases all have X > 0, they do not correspond to mixes
c  that are likely to be encountered by investigators, but they do give another
c  estimate of interpolation errors for some CO-rich mixes.  (Note that there
c  are several other cases where mixes with identical compositions appear at
c  two different places in the matrix CO, but these occur at tabulated Z-values
c  and thus have identical opacity values.)  Differences for the CO-rich cases
c  with identical compositions (note that T6 < 0.01 were omitted):
c
c  Differences for CO-rich mixes interpolated in two different ways:
c  -----------------------------------------------------------------
c
c   case:   Z=0.04 X=0.35   Z=0.07 X=0.7    Z=0.09 X=0.7
c          ==============  ==============  ==============
c  C & O:  .01 .6  .6 .01  .03 .2  .2 .03  .01 .2  .2 .01
c          ------  ------  ------  ------  ------  ------
c     max  -.0333  -.0026  -.0491  -.0110  -.0422  -.0084  (dLogKappa)
c    mean  -.0029  -.0002  -.0046  -.0014  -.0041  -.0011
c     rms   .0061   .0008   .0091   .0029   .0081   .0023
c
c  These errors are still quite small, with an rms of 1% or less, smaller than
c  the estimated error in the opacity computations quoted above or than the
c  largest of the Z-interpolation errors at C=O=0.0 (though larger than the
c  errors for the C=O=0.0 mix for the same metallicity Z).  The maximum error
c  is less than 12% (note that the maximum errors tend to lie at fairly low
c  temperatures, where CO-rich opacities are less likely to be needed).
c
c  The above tables of errors were obtained by considering Z-interpolation as
c  the opacities were read in.  One may also compare opacities where the only
c  Z-interpolation was performed on input (i.e., Nzin = 1 in READZEXCO) with
c  opacities interpolated in Z by the call to OPAC or OPAL (i.e., which had had
c  Z > 4 in READZEXCO).  These are interpolated among somewhat different grid
c  points, and thus give some idea of the Z-interpolation and CO-interpolation
c  errors.  NOTE THAT USE OF COINTERP WILL LEAD TO SIGNIFICANTLY LARGER ERRORS,
c  as discussed further below.  For several Z-values, the number of points
c  compared and the maximum and rms differences in log10(Kappa) are given below
c  both at and between (X,T6,R,C,O) gridpoints, for low (4<logT<6) and high
c  (logT>6) temperatures (T6 < 0.01 are omitted; table Z-values are also
c  omitted, since opacity differences are zero there, as expected).  Note that
c  rms differences are always small, less than 0.3%, but this may be misleading
c  as many comparison points will interpolate between the same gridpoints, just
c  in a different order, and thus will have identical interpolated log10(Kappa)
c  values.  For C = O = 0.0, the maximum differences are small, less than 1%;
c  however, the CO-interpolation can induce somewhat larger errors in opacities
c  of CO-rich mixes at low metallicity: for logT > 6 at X = 0.0 (where CO-rich
c  opacities are likely to be needed), the maximum differences do not exceed
c  1% for Z > 0.001, but they can be as high as 8% for 0.0001 < Z < 0.001, and
c  can reach 11% for Z < 0.0001.
c
c  "max" gives some indications of combined Z- and CO-interpolation errors:
c  ------------------------------------------------------------------------
c
c     dLogKappa for:                        <-------- max{C,O} > 0.0 --------->
c       <------ C = O = 0.0 , all X ------> <----On-Grid----> <----Off-Grid--->
c       <----On-Grid----> <----Off-Grid--->   all X   X = 0.0   all X   X = 0.0
c   Z   4<logT<6   logT>6 4<logT<6   logT>6   logT>4   logT>6   logT>4   logT>6
c ===== -------- -------- -------- -------- -------- -------- -------- --------
c .00001:N= 3895     2075    27695    15375   273426    21580  7185558   315535
c   max -.000038  .000067 -.000069  .000121 -.066377  .009322 -.093110  .012053
c   rms  .000003  .000004  .000004  .000004  .000178  .000103  .000174  .000074
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .00005:N= 3895     2075    27695    15375   279396    21995  7228628   314790
c   max -.000080  .000171 -.000156  .000310  .046540  .039973 -.118741  .046853
c   rms  .000008  .000009  .000010  .000010  .000401  .000363  .000352  .000230
c .0002:-------- -------- -------- -------- -------- -------- -------- --------
c   max -.000214  .000447 -.000404  .000828 -.041788  .028401 -.058897 -.035296
c   rms  .000010  .000015  .000012  .000016  .000365  .000267  .000317  .000197
c .0005:-------- -------- -------- -------- -------- -------- -------- --------
c   max -.000316 -.000304 -.000512  .000854 -.044971  .017734 -.061407  .020958
c   rms  .000025  .000025  .000032  .000030  .000357  .000155  .000271  .000121
c .0015:-------- -------- -------- -------- -------- -------- -------- --------
c   max  .001481 -.000494  .002325  .001390 -.019924  .001625 -.025380  .001904
c   rms  .000086  .000033  .000111  .000042  .000202  .000062  .000165  .000059
c .0030:-------- -------- -------- -------- -------- -------- -------- --------
c   max -.001855 -.000593 -.002934 -.001971 -.006332 -.001797  .006585 -.002046
c   rms  .000107  .000032  .000138  .000049  .000181  .000076  .000158  .000072
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .0070: N= 3895     2075    27695    15375   279396    21995  7218820   314790
c   max  .000882  .000475  .001406 -.001663 -.005493  .001000 -.008853  .001083
c   rms  .000054  .000026  .000070  .000041  .000098  .000044  .000111  .000043
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .0150: N= 3895     2075    27695    15375   279396    21995  7199204   314790
c   max -.000052 -.000111 -.000136 -.000213 -.009724 -.000550  .038904 -.001056
c   rms  .000002  .000010  .000003  .000009  .000087  .000019  .000482  .000019
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .0250: N= 3895     2075    27695    15375   277008    21995  7137840   314790
c   max  .000087 -.000088  .000233 -.000140 -.003307  .000414  .036001 -.000738
c   rms  .000006  .000009  .000009  .000009  .000049  .000025  .000439  .000023
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .0350: N= 3895     2075    27695    15375   277008    21995  7059376   314790
c   max -.000253 -.000406  .002127  .000610 -.005123 -.000655 -.041995 -.000777
c   rms  .000024  .000031  .000032  .000033  .000099  .000046  .000626  .000050
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .0450: N= 3895     2075    27695    15375   274620    21995  7022532   314790
c   max  .000980  .000782  .001798  .003339  .009452  .000765  .054504  .001237
c   rms  .000061  .000076  .000069  .000090  .000149  .000065  .000921  .000080
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .0550: N= 3895     2075    27695    15375   268650    21995  6940230   311300
c   max  .000457 -.000596  .001611 -.001637  .004770 -.000654  .006170  .001523
c   rms  .000043  .000055  .000047  .000060  .000081  .000045  .000108  .000041
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .0700: N= 3895     2075    27695    15375   266262    21995  6844538   311300
c   max -.000404 -.000476  .001360 -.001767  .007161 -.000599  .042980 -.001666
c   rms  .000027  .000038  .000032  .000046  .000175  .000036  .000708  .000097
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c .0900: N= 3895     2075    27695    15375   263874    21995  6665478   311300
c   max -.000236  .000500 -.001106  .002409  .008298  .000866 -.045470  .004078
c   rms  .000022  .000042  .000034  .000066  .000221  .000029  .000966  .000140
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c
c
c  Z-interpolation errors when one uses linear Z-interpolation (Nzin = 2):
c  =======================================================================
c
c  If, for example, diffusion leads to relatively small Z-variations in a star
c  (say, of order 10%), then one might wish to use linear interpolation in logZ
c  by setting  nZin = 2  in READZEXCO.  (Note that opacity interpolation with
c  nZin = 2  will usually be significantly faster than  nZin = 3 , which will
c  in general be faster than  nZin = 4 ; however, all values of  nZin > 4  take
c  the same amount of time as the  nZin = 4  case, except for the slight added
c  start-up time to read in the extra opacity files).  The size of the errors
c  introduced by  nZin = 2  linear interpolation are easily estimated, e.g., by
c  comparing { nZin = 2, Zlo = .019, Zhi = .021 } opacities at Z = 0.02 with
c  the Z=0.02 opacity tables themselves.  Such errors for the  nZin = 2  case
c  are tabulated below for several values of Z, for two different cases with
c  Z-ranges of +/- 10% and of +/- 20%, respectively (referred to as cases "1"
c  and "2" in the table headings on the left).  The mean errors are given as
c  well as the maximum and rms errors, since it is not unreasonable to expect
c  a systematic tendency from linear interpolation of a curve; however, they
c  turn out to be negligible (always < 0.04%) for a Z-range of +/- 10%.  The
c  rms error in the Z-interpolation is likewise negligible (always < 0.2%) for
c  a Z-range of +/- 10%; the maximum errors are less than 1% for C = O = 0.0,
c  and also for Z > 0.001 at logT > 6 with X = 0.0, max{C,O} > 0.0, although
c  for Z < 0.001 the CO-interpolation can result in errors up to 9% in a few
c  places for CO-rich mixes.  Even for a Z-range of +/- 20%, the mean errors
c  are always < 0.14%; the C = O = 0.0 case has rms errors < 0.2% and maximum
c  errors < 1.7%, while { Z > 0.001, logT > 6, X = 0.0, max{C,O} > 0.0 } has
c  rms errors < 0.21% and maximum errors < 1.4% (up to 9% for Z < 0.001).
c
c  Errors if linear Z-interpolation is used, with Z-ranges +/-10% and +/-20%:
c  --------------------------------------------------------------------------
c
c     Z= 0.0001   0.001    0.004    0.01     0.02     0.03     0.05     0.08
c       ======== ======== ======== ======== ======== ======== ======== ========
c Zlo1=  0.00009  0.0009   0.0036   0.009    0.018    0.027    0.045    0.072
c Zhi1=  0.00011  0.0011   0.0044   0.011    0.022    0.033    0.055    0.088
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c Zlo2=  0.00008  0.0008   0.0032   0.008    0.016    0.024    0.040    0.064
c Zhi2=  0.00012  0.0012   0.0048   0.012    0.024    0.036    0.060    0.096
c       ======== ======== ======== ======== ======== ======== ======== ========
c C=O=0.0, OnGrid, logT>4 dLogKappa:
c  max1 -.000703  .001008  .001107  .000764  .000989  .000925 -.001984  .001149
c mean1 -.000026  .000017  .000065  .000103  .000133  .000145  .000150  .000149
c  rms1  .000056  .000064  .000109  .000146  .000183  .000199  .000241  .000214
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c  max2 -.002772  .001246 -.002859  .003076  .003924  .003731  .004402  .004059
c mean2 -.000103  .000043  .000238  .000416  .000537  .000583  .000612  .000609
c  rms2  .000219  .000145  .000375  .000587  .000733  .000793  .000857  .000853
c       ======== ======== ======== ======== ======== ======== ======== ========
c C=O=0.0, OffGrid, logT>4 dLogKappa:
c  max1 -.000707 -.002721  .003203  .001427  .002620  .002294  .003412  .002120
c mean1 -.000024  .000015  .000065  .000100  .000130  .000143  .000149  .000149
c  rms1  .000051  .000076  .000119  .000141  .000178  .000197  .000245  .000213
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c  max2 -.002806 -.002473 -.005426  .005459  .005472  .003856  .006457  .007094
c mean2 -.000095  .000041  .000232  .000405  .000524  .000573  .000606  .000605
c  rms2  .000198  .000153  .000367  .000568  .000713  .000780  .000848  .000849
c       ======== ======== ======== ======== ======== ======== ======== ========
c max{C,O}>0.0, X=0.0, OnGrid, logT>6 dLogKappa:
c  max1 -.032688  .000776  .000689 -.000687  .000569  .000581 -.001612  .000677
c mean1 -.000003  .000007  .000030  .000065  .000098  .000115  .000148  .000147
c  rms1  .000221  .000024  .000063  .000117  .000163  .000190  .000248  .000219
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c  max2 -.032967  .000873  .001402  .001871  .002107  .002235  .002763  .002591
c mean2 -.000005  .000027  .000122  .000262  .000395  .000464  .000589  .000593
c  rms2  .000223  .000071  .000247  .000468  .000651  .000749  .000905  .000875
c       ======== ======== ======== ======== ======== ======== ======== ========
c max{C,O}>0.0, X=0.0, OffGrid, logT>6 dLogKappa:
c  max1 -.038349  .001053  .000879 -.001188 -.000875 -.001059 -.002342 -.002052
c mean1 -.000002  .000007  .000029  .000064  .000097  .000114  .000148  .000148
c  rms1  .000140  .000023  .000060  .000114  .000160  .000187  .000244  .000222
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c  max2 -.038750 -.001171  .001398  .002108  .002854 -.003313 -.004253 -.006058
c mean2 -.000004  .000027  .000118  .000257  .000390  .000458  .000586  .000594
c  rms2  .000156  .000071  .000239  .000458  .000641  .000740  .000898  .000881
c       ======== ======== ======== ======== ======== ======== ======== ========
c max{C,O}>0.0, all-X, OnGrid, logT>4 dLogKappa:
c  max1 -.032688 -.025873 -.001446  .001413 -.003337  .003056 -.009148  .001397
c mean1 -.000017  .000015  .000039  .000078  .000106  .000121  .000134  .000137
c  rms1  .000111  .000135  .000075  .000118  .000159  .000179  .000261  .000198
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c  max2 -.036713 -.025350  .005615  .005444  .007725 -.008038 -.007972  .007035
c mean2 -.000058  .000047  .000154  .000320  .000439  .000495  .000567  .000569
c  rms2  .000237  .000228  .000250  .000463  .000615  .000697  .000813  .000804
c       ======== ======== ======== ======== ======== ======== ======== ========
c max{C,O}>0.0, all-X, OffGrid, logT>4 dLogKappa:
c  max1 -.038349 -.034450 -.004328 -.004072 -.028706 -.028234 -.047400  .041999
c mean1 -.000015  .000016  .000039  .000078  .000102  .000116  .000119  .000143
c  rms1  .000073  .000101  .000075  .000116  .000377  .000375  .000776  .000729
c ----- -------- -------- -------- -------- -------- -------- -------- --------
c  max2 -.050575 -.032346  .005371  .008759 -.027245  .052397 -.045954  .042481
c mean2 -.000056  .000050  .000152  .000318  .000432  .000494  .000546  .000576
c  rms2  .000193  .000174  .000245  .000461  .000692  .000952  .001109  .001302
c       ======== ======== ======== ======== ======== ======== ======== ========
c
c
c  +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c  Details of opacity shifts from initial smoothing when opacities are read in
c  +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c  The opacity tables to be interpolated among (i.e., the OPAL files) are known
c  to have somewhat random numerical errors of a few percent.  Consequently,
c  adjusting the data prior to performing the interpolation is justified at
c  this level.  The code first reads the original (unsmoothed) tabular data;
c  this data is then passed through a smoothing filter, using a set of routines
c  developed by Mike Seaton (see M.J. Seaton, MNRAS 265, L25, 1993).  It is the
c  adjusted data that is actually used in carrying out the interpolations in
c  OPAC or OPAL.  The initial adjustment step helps improve the smoothness of
c  the OPAC output, particularly at the smallest values of R.  The medium to
c  large R output is only slightly affected by this step.  It takes only a
c  few seconds to carry out the initial data smoothing step, but this initial
c  smoothing can be skipped by calling the subroutine SET_SMOOTH (described
c  further above) with a value of  initsmooth = 0 .
c     In addition, a few opacities in the mixes adjacent to the C=O=0.0 mix
c  (i.e., in the three mixes with C or O = 0.01, and C+O no more than 0.02)
c  are smoothed in the C-O direction, if opacity changes between mixes with
c  C,O = 0.0, 0.03, 0.1 are monotonic but the opacity at C,O = 0.01 does not
c  fit the trend; the resulting adjustments are small, and only occur at a
c  small minority of the (T6,R) points, but this smoothing can also be skipped,
c  by calling SET_SMOOTH (described further above) with  lowCOsmooth = 0 .
c
c  Maximum and rms differences between smoothed and unsmoothed opacity tables
c  for selected metallicities Z, for non-CO-rich mixes ("CO=0") and CO-rich
c  mixes ("CO>0") of each hydrogen abundance X, at intermediate temperatures
c  ("4<logT<6") and high temperatures ("logT>6"); note: T6 < 0.01 was omitted:
c
c  Opacity shifts resulting from initial smoothing when they are read in:
c  ----------------------------------------------------------------------
c
c     dLogKappa for:
c           X =    0.00         0.03         0.10         0.35         0.70
c              ------------ ------------ ------------ ------------ ------------
c                max   rms    max   rms    max   rms    max   rms    max   rms 
c Z=0.0: CO=0: ====== ===== ====== ===== ====== ===== ====== ===== ====== =====
c     4<logT<6  .0288 .0062  .0492 .0082  .0534 .0072  .0278 .0044  .0168 .0026
c       logT>6  .0172 .0023  .0175 .0022  .0160 .0021  .0125 .0016 -.0038 .0006
c   CO>0:      ------ ----- ------ ----- ------ ----- ------ ----- ------ -----
c     4<logT<6 -.0512 .0077  .0761 .0075  .0763 .0064  .0800 .0050  .0874 .0037
c       logT>6  .0767 .0025  .0771 .0026  .0776 .0026  .0782 .0027  .0757 .0017
c Z=.001:CO=0: ====== ===== ====== ===== ====== ===== ====== ===== ====== =====
c     4<logT<6 -.0416 .0064  .0469 .0079  .0524 .0069  .0255 .0043  .0154 .0027
c       logT>6 -.0149 .0022 -.0148 .0021 -.0145 .0020 -.0124 .0016  .0059 .0011
c   CO>0:      ------ ----- ------ ----- ------ ----- ------ ----- ------ -----
c     4<logT<6  .0792 .0072  .0689 .0072  .0528 .0061 -.0517 .0047  .0458 .0033
c       logT>6 -.0324 .0023 -.0341 .0023 -.0362 .0024 -.0369 .0024 -.0153 .0015
c Z=.02: CO=0: ====== ===== ====== ===== ====== ===== ====== ===== ====== =====
c     4<logT<6 -.0570 .0069  .0483 .0076  .0517 .0066  .0200 .0043 -.0128 .0031
c       logT>6 -.0108 .0021 -.0113 .0021 -.0110 .0021 -.0107 .0020 -.0083 .0017
c   CO>0:      ------ ----- ------ ----- ------ ----- ------ ----- ------ -----
c     4<logT<6  .0785 .0071  .0675 .0069  .0521 .0057 -.0493 .0044 -.0375 .0033
c       logT>6 -.0303 .0023 -.0320 .0023 -.0345 .0024 -.0343 .0024 -.0140 .0016
c Z=.10: CO=0: ====== ===== ====== ===== ====== ===== ====== ===== ====== =====
c     4<logT<6 -.0397 .0073  .0564 .0078  .0496 .0066  .0182 .0047 -.0137 .0038
c       logT>6 -.0093 .0021 -.0096 .0021 -.0097 .0021 -.0096 .0021 -.0087 .0018
c   CO>0:      ------ ----- ------ ----- ------ ----- ------ ----- ------ -----
c     4<logT<6  .0765 .0074  .0664 .0070  .0497 .0058 -.0404 .0046 -.0259 .0038
c       logT>6 -.0246 .0023 -.0262 .0023 -.0273 .0024 -.0259 .0023 -.0095 .0017
c
c  For T6 > 0.01, the rms effect of the smoothing is always less than 2%, i.e.,
c  comparable to the Z-interpolation errors found for the CO-rich mixes above,
c  and smaller than the estimated opacity computation errors.
c
c
c    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c    Details of differences in CO-rich opacities from COINTSMO vs. COINTERP
c    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c  Use of the smoother CO-interpolation routine COINTSMO (rather than the old
c  routine COINTERP) yields opacities that differ at only a few grid-points
c  (those which COINTERP ignores when interpolating opacities), but that differ
c  over a significant area of the CO-plane between grid-points.  Opacities
c  were compared at points chosen randomly in log T, log RHO, C, and O (always
c  with C+O > 0, and with some excess probability of having either C=0, O=0,
c  or C+O=1-X-Z).  Opacity differences are tabulated below for selected
c  metallicities Z, for X = 0 and for two ranges of non-zero X, at intermediate
c  temperatures ("4<logT<6") and high temperatures ("logT>6"); note that very
c  low temperatures (T6 < 0.01) were omitted:
c
c  CO-interpolation differences: from using subroutines COINTSMO vs. COINTERP:
c  ---------------------------------------------------------------------------
c
c  dLogKappa for:       X = 0.0           0.0 < X < 0.35       0.35 < X < 0.8
c                 -------------------  -------------------  -------------------
c                    N     max   rms      N     max   rms      N     max   rms
c Z=0.0:          ====== ====== =====  ====== ====== =====  ====== ====== =====
c       4<logT<6  209131 -.0495 .0021   91697 -.0540 .0042  117239 -.0939 .0061
c         logT>6  252334 -.0198 .0009  109760 -.0575 .0045  142313  .1272 .0062
c Z=0.001:        ====== ====== =====  ====== ====== =====  ====== ====== =====
c       4<logT<6  208824 -.0376 .0019   91547 -.0525 .0040  117033  .0872 .0056
c         logT>6  251965 -.0195 .0008  109603 -.0568 .0045  142087  .1259 .0061
c Z=0.02:         ====== ====== =====  ====== ====== =====  ====== ====== =====
c       4<logT<6  208225 -.0275 .0014   91265  .0388 .0032  116669  .0975 .0042
c         logT>6  251235 -.0161 .0006  109266  .0538 .0039  141670  .1031 .0051
c Z=0.1:          ====== ====== =====  ====== ====== =====  ====== ====== =====
c       4<logT<6  207954 -.0189 .0010   91162  .0318 .0024  116518  .0591 .0031
c         logT>6  250923 -.0104 .0003  109122  .0452 .0029  141482  .0812 .0039
c
c  The routine COINTERP may have opacity discontinuities of the same order as
c  the opacity differences (up to 5%, for X=0 and logT > 6; larger elsewhere),
c  at those points where it switches over from interpolation in one direction
c  to interpolation in another direction, interpolating among a different set
c  of gridpoints (this generally occurs somewhere in the region O = C +/- 0.2).
c
c
c   +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c   Details of the individual OPAL opacity tables and program storage space
c   +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c  Each of the individual tables in a file Gz???.x?? covers 70 temperatures
c  in the range logT=3.75 [T6=0.0056341325] (referred to as temperature 1) to
c  logT=8.7 [T6=501.187] (note that the logT step size is 0.05 below logT=6.0,
c  0.10 below logT=8.1, and 0.20 above that), and covers 19 values of log R in
c  the range logR=-8.0 (referred to as 1) to logR=+1.0, at half-integer steps.
c  (NOTE: earlier tables were explicitly in terms of T6.  For convenience the
c  present tables tabulate log Kappa vs logT.  The interpolation however still
c  uses logT6 for the temperature variable, not logT.)  Values of Z from 0.0
c  to 0.1 are available (at up to 14 values of Z).  Type 2 OPAL tables have
c  8 Z-values from Z = 0.0 to Z = 0.1 and 5 X-values from X = 0.0 to X = 0.7
c  (plus 8 each of excess-C and excess-O values from 0.0 to 1 - X - Z), while
c  Type 1 OPAL tables have 13 Z-values from Z = 0.0 to Z = 0.1 and 10 X-values
c  from X = 0.0 to X = 1 - Z (but with less-good X-interpolation at low X);
c  combining these tables allows accurate X-interpolation at all X, and more
c  accurate Z-interpolation among 14 Z-values.
c     The sizes of the matrices (holding the input opacities) are set by the
c  constant values in parameter statements.  The number  NZ  of available
c  Z-storage values was mentioned above (in the discussion of the inputs to the
c  subroutine READZEXCO); its value in the parameter statements can be changed
c  to any value between 1 and 14 (provided that it is the same everywhere!) and
c  the program recompiled.  Smaller values of  NZ  yield smaller ranges where
c  Z can be interpolated (or less accurate interpolation over a wide range),
c  but also save storage space; NZ = 5 is a reasonable compromise.  Low values
c  (NZ = 2 or 3) yield less accurate interpolation, but reduce both the storage
c  space and the typical amount of CPU-time per opacity interpolation, since
c  fewer Z-grid values need to be computed in general.  For NZ = 1, only a
c  constant Z can be accomodated.  Other than NZ, no size parameter of the OPAL
c  matrices should be changed.
c     The molecular and conductive opacity matrix sizes are independent of NZ,
c  taking up about 1 Mb; their sizes should never be changed.  The Ferguson et
c  al. (2005) molecular opacity tables have the same range in logR as the OPAL
c  tables, but with 2.7 < logT < 4.5 (or possibly 2.8 < logT < 4.5 for some
c  cases); they are available at 16 Z-values from Z = 0.0 to Z = 0.1, and at
c  10 X-values from X = 0.0 to X = 1 - Z.  For low X, their X-interpolation is
c  less accurate (but at low temperatures where molecular opacities are needed
c  one seldom will encounter X values close to zero).
c
c  Roughly  (1.1 Mb) + NZ * (1.63 Mb)  of storage space is required in total.
c
c
c******************************************************************************
c
      block data opal_opac_data
c     =========================
c
      parameter ( small_1m6=1.e-6 )
c
c  COMMON BLOCK DATA INITIALIZATIONS:
c  ----------------------------------
c
c PARAMETERS defining the matrices used to hold the opacity values:
c  nz = 14 = maximum number of Z-tabulation values (see arrays zavail, zsto)
c  mx = 5 = number of X-tabulation values (see array xa)
c  mc = mo = 8 = number of C- and O-tabulation values (see arrays xcs and xos)
c  nrm = 19 = maximum number of R-tabulation values (see array alrf)
c  nrb = 1 = index of lowest R-value to be stored         \  default: store
c  nre = 19 = index of highest R-value to be stored        }  all 19 R-values
c  nr = nre-nrb+1 = 19 = number of R-values to be stored  /
c  ntm = 70 = maximum number of T-tabulation values (see array flogtin)
c  ntb = 1 = index of lowest T-value to be stored         \  default: store
c  nt = ntm-ntb+1 = 70 = number of T-values to be stored  /   all 70 T-values
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
c PARAMETERS nrdel and ntdel give matrix position differences that result from
c  any reduction of nr or nt due to increased nrb or ntb values, respectively
c
      parameter ( nrdel=nrb-1, ntdel=ntb-1 )
c
c PARAMETERS:
c  zdel = 0.001 = offset for Z, Z+C, and Z+O, to make log interpolation behave
c                  reasonably at small Z values: Z-interpolation is performed
c                  using log(Z+zdel), while the CO-interpolation is performed
c                  using log(C+Z+zdel) and log(O+Z+zdel)
c  xdel = 0.03 = usual (high-T) offset for X, to make log interpolation behave
c                 reasonably at small X; note that 0.03 works better than 0.005
c  xdelmin = 0.001 = lowest value of X offset ever used (at low temperatures)
c
      parameter ( zdel=0.001, xdel=0.03, xdelmin=0.001 )
c
c PARAMETERS defining the storage for the additional X-values from 'GN93hz':
c  mx_hi = 10 = number of X-values contained in 'GN93hz'.
c  mo_m1 = mo - 1 = 7 : used for the position in the matrix  co()  below where
c                         some of the 'GN93hz' opacity-shifts will be stored
c                         (see COMMON /a_opal_z/ below, for this matrix)
c  mx_hi_nz = mx_hi * nz : the number of initialization values requred for the
c                            matrix  xhi_use()  in COMMON /xhi_opal_z/ below.
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mx_hi_nz=mx_hi*nz )
c
c COMMON /xhi_opal_z/ : auxiliary matrices for additional 'GN93hz' X-values:
c  xhi_in(mx_hi) = { 0.0, 0.1, 0.2, 0.35, 0.5, 0.7, 0.8, 0.9, 0.95, 1.0 },
c                    the X-values contained in 'GN93hz' (for the case Z=0.0)
c  xcno_use(mx_hi,nz) = the 'GN93hz' X-values available for each stored Z-value
c                         (indexed by kz = 1, ..., numz); note that for each
c                         value of kz the highest X-value is 1 - Z(kz)
c  xhi_use(mx_hi,nz) = the 'GN93hz' X-values same as xcno_use(mx_hi,nz), except
c                        that xhi_use(1,kz) = 0.03 (from 'Gz???.x03' files)
c  xxx_cno(mx_hi) = log10( xhi_in() + xdel ) = logarithmic 'GN93hz' X-values
c  xxx_hi(mx_hi) = logarithmic 'GN93hz' X-values same as xxx_cno(mx_hi), except
c                    that xxx_hi(1) = log10( 0.03 + xdel )
c  nx_hi(nz) = number of 'GN93hz' X-values in xhi_use() at each stored Z-value
c  ireq_hi(mx_hi) = flags to tell whether the corresponding 'GN93hz' X-values
c                     are unavailable from the 'Gz???.x??' files
c  khighx(nz) = flag to tell whether the 'GN93hz' opacities were read in, for
c                 each of the stored Z-values
c  kavail_xhi = flag to tell whether the 'GN93hz' opacities are available
c  kuse_xhi = flag to tell whether the 'GN93hz' X-values should be used for
c               X-interpolation (see description of subroutine SET_XHI above)
c  kdo_xhi = internal flag controlling use of the 'GN93hz' X-values
c  kavail_cno = flag to tell whether the CNO-interpolation deltas are available
c  kuse_cno = flag to tell whether CNO-interpolation should be performed
c  kdo_cno = internal flag controlling use of CNO-interpolation
c  kavail_user = flag to tell whether user-interpolation deltas are available
c  kuse_user = flag to tell whether user-interpolation should be performed
c  kdo_user = internal flag controlling use of user-interpolation
c
c /xhi_opal_z/: --> data{ALL}
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
c COMMON /a_opal_z/ : matrices for opacity storage and interpolation:
c  indx(101) is used to get tabulation-index from excess C or O values: INDX
c              (see data) refers to the index i of abundance grid points xc(i)
c              or xo(i): e.g., i = indx( int( 100. * max( C , 0. ) + 1. ) )
c  t6list(nt) = stored-grid T6 values (obtained from logT values)
c  alr(nr) = stored-grid log(R) values (at log(R)-intervals of 0.5)
c  n(mx,mo,nz) = the number of different C-tables present at each X-tabulation,
c                 O-tabulation, and Z-tabulation value (see also array  nofz
c                 in common/zinter_opal_z/ )
c  alt(nt) = stored-grid log(T6) values; note log(T6) = log(T) - 6.
c  dfs(nt) = stored-grid inverse log(T6)-spacing: dfs(i) = 1./[alt(i)-alt(i-1)]
c             (note that dfs(1) = dfs(2), for convenience)
c  dfsr(nr) = stored-grid inverse log(R)-spacing (unlike dfs, the dfsr values
c              are all equal): dfsr(i) = 1./[alr(i)-alr(i-1)] = 2.
c  b(3) is used to hold intermediate values during C-O interpolation
c  m = the index of the current X-table
c  mf = the lowest (first) index of the X-table(s) needed for X-interpolation
c  xa(8) = the tabulated X-values: actually there are only five (see "data"),
c            namely, xa(1:5) = { 0.0, 0.03, 0.1, 0.35, 0.7 }
c  alrf(nrm) = opacity-file-grid log(R) values (note that this grid, with nrm
c               log(R) values, may be larger than the stored-grid, with nr)
c  flogtin(ntm) = opacity-file-grid log(T) values (again, ntm may be > nt)
c  dfsx(mx) = inverse logarithmic-X-grid spacings: dfsx(i) = 1./[xx(i)-xx(i-1)]
c  oxf(mx,mc,nz) = logarithmic-O-grid tabulation values for a given C value:
c                   for each X-table index m and Z-table index k,  oxf(m,i,k) =
c                   log10[ min{ xos(i) , 1-xa(m)-zsto(k) } + zsto(k) + 0.001 ]
c  cxf(mx,mo,nz) = logarithmic-C-grid tabulation values similarly
c  xcdf(mx,mo,nz) = maximum possible C value for a given O value:
c                    for each X-table index m and Z-table index kz,
c                    xcdf(m,i,kz) = 1 - xa(m) - zsto(kz) - xo(i)
c  xodf(mx,mc,nz) = maximum possible O value for a given C value, similarly
c  itime = "opacities available" flag (initially 0): itime is set to 12345678
c             when all opacities have been read in.
c  cxdf(mx,mo,nz) = logarithmic maximum C value for a given O value:
c                    for each X-table index m and Z-table index kz,
c                    cxdf(m,i,kz) = log10[ xcdf(m,i,kz) + zsto(kz) + 0.001 ]
c  oxdf(mx,mc,nz) = logarithmic maximum O value for a given C value, similarly
c  q(4) = temporary: opacity-derivative at each T, in T-R interpolation
c  h(4) = temporary: opacities log10(Kappa) at each T, in T-R interpolation
c  xcd(mc) = maximum possible C at present m and kz:  xcd(i) = xcdf(m,i,kz)
c  xod(mc) = maximum possible O at present m and kz:  xod(i) = xodf(m,i,kz)
c  xc(mc) = C-tabulation at present m and kz: xc(i) = min{ xcs(i) , 1-xa(m)-Z }
c  xo(mo) = O-tabulation at present m and kz: xo(i) = min{ xos(i) , 1-xa(m)-Z }
c  xcs(mc) = C-tabulation values: see "data"
c  xos(mo) = O-tabulation values: see "data"
c  cxd(mc) = logarithmic maximum C value for a given O value at present X-table
c             index m and Z-table index kz: cxd(i) = cxdf(m,i,kz)
c  oxd(mo) = logarithmic maximum O value for a given C value, similarly
c  cx(mc) = logarithmic-C-grid tabulation values at present X-table index m and
c            Z-table index kz: cx(i) = cxf(m,i,kz)
c  ox(mo) = logarithmic-O-grid tabulation values at present m, similarly
c  zzz(nz) = shifted Z-value (for logarithmic interpolation purposes):
c             for each Z-table index kz,  zzz(kz) = zsto(kz) + 0.001
c  xxh = xh = stored value of desired X value (xxh is never actually used)
c  xx(mx) = logarithmic-X-grid tabulation values: xx(i) = log10[ xa(i) + 0.03 ]
c            (note that previous program versions added 0.005 rather than 0.03;
c            the latter works better for X near zero at log(T) > 5.)
c  nc = n(m,1,kz) = number of C-grid values available at X,Z-table indices m,kz
c  no = nc = number of O-grid values, similarly
c  zsto(nz) = stored Z-values available for Z-interpolation
c  zvint(nz) = logartihmic stored Z-values: zvint(i) = log10[ zsto(i) + 0.001 ]
c  dfsz(nz) = inverse log-Z-grid spacings: dfsz(i) = 1./[zvint(i)-zvint(i-1)]
c  zacc(nz) = accuracy with which Z must match the corresponding stored Z-value
c              in order to be considered equal to it
c  zlow,zmiddle,zhigh = lowest, "typical", and highest stored Z-values
c  zlo_ex,zhi_ex = extreme Z-limits for Z-extrapolation
c  numz = number of stored Z-values available for Z-interpolation
c
c-SIZE 4*(101+3*nt+ntm+2*nr+nrm+10*mc+mx+3+2+8+1+2*4+1+2+6)
c      + nz * 4*(7*mx*mc+5) = 0.002 + (nz/14) * 0.015 Mb
c
c /a_opal_z/: --> data{indx,xcs,xos,xa,itime}
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
c COMMON /a_co_opal_z/ : matrix for actual opacity storage (was in /a_opal_z/):
c  co(mx,mc,mo,nt,nr,nz) = stored opacities log10(Kappa): co(m,i,j,k,l,kz) =
c                           log10[ Kappa(X_m,C_i,O_j,T_k,R_l,Z_kz) ] , where
c                           X_m = xa(m), C_i = min{xcs(i),1-xa(m)-Z-xos(j)},
c                           O_j = xos(j), T_k = alt(k), R_l = alr(l), and
c                           Z_kz = zsto(kz); except that, for j = mo, the
c                           "diagonal" tables are stored, with C_i = xcs(i) and
c                           O_j = 1-xa(m)-zsto(kz)-xcs(i).  Note that not quite
c                           all (m,i,j) locations are used; unused locations
c                           (m,mc,mo,...) and (m,mc,mo-1,...) are used for
c                           temporary storage for opacities from 'GN93hz' and
c                           the file with non-zero [O/Fe], if these are used.
c******************************************************************************
c  Note that the old arrays "diag" & "diago" are not needed; here:
c  co(m,n(m,i,kz),i,it,ir,kz) = diag(m,i,it,ir,kz)  and
c  co(m,i,mo,it,ir,kz) = diago(m,n(m,1,kz)-i,it,ir,kz) = diago(m,no-i,it,ir,kz)
c******************************************************************************
c  opk(mx,4) = temporary: for each X-table index m used in the X-interpolation,
c               opk(m,1:4) holds the log10(Kappa) value and the derivatives
c               with respect to T (at constant R), to R (at constant T), and to
c               T (at constant density), for that m value (already interpolated
c               in C, O, Z, T, and R)
c  opl(nt,nr,nz) = temporary: for each stored-grid (T_k,R_l,Z_kz) value used in
c                   the T-R-Z interpolation,  opl(k,l,kz)  holds the opacity
c                   log10(Kappa) at that T_k, R_l, and Z_kz (already
c                   interpolated in C and O); the Z-interpolated values at each
c                   (T_k,R_l) are subsequently stored in  opl(k,l,1)
c  cof(nt,nr) = temporary: in the subroutine READEXCO, cof is used temporarily
c                to hold the opacities for non-zero [O/Fe] where they will not
c                be overwritten when reading in the 'GN93hz' opacities; in the
c                subroutine COINTSMO, cof is used temporarily to hold some
c                logarithmic C and O grid-values
c
c-SIZE 4*(nt*nr+mx*4) + nz * 4*(mx*mc*mo+1)*nt*nr = 0.005 + (nz/14) * 22.800 Mb
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
c COMMON /b_opal_z/ : high and low logT6 and logR limits, and mix Z-values:
c  nta(0:nrm+1) = maximum T-index where opacity values exist for each R-index;
c                  if nre < nrm, then nta(nre+1:nrm) will be set to -99, to
c                  indicate that no opacities are present there (values at
c                  positions < nrb are NOT reset, however); see "data"
c  ntax0(0:nrm) = minimum T-index where opacity values exist in the X=0.0 (m=1)
c                  tables; if nrb > 1, then ntax0(0:nrb-1) will be set to 999,
c                  to indicate that no opacities are present there (values at
c                  positions > nre are NOT reset, however).  The worst-case
c                  values given below (see "data") are reset to the actual
c                  values when the opacities are read in by READEXCO
c  ntax03(0:nrm) = minimum T-index in the X=0.03 (m=2) tables, similarly
c  sltlo, slthi = low and high logT6 limits: a logT6 value outside this range
c                  is considered to require extrapolation (by default these
c                  these limits lie at the boundaries of the matrix; they may
c                  be reset to lie inside it, but not outside it)
c  dltlo_inv, dlthi_inv = (inverse of) allowed extrapolation delta_logT6 beyond
c                          the above limits sltlo, slthi: by default, one grid
c                          spacing beyond the edge of the matrix (they can be
c                          reset, but in no case will extrapolation be allowed
c                          more than one grid spacing beyond the matrix edge)
c  slrlo, slrhi = low and high logR limits (handled similarly to logT6 limits)
c  dlrlo_inv, dlrhi_inv = (inverse of) allowed extrapolation delta_logR
c
c /b_opal_z/: --> data{ALL}
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
c COMMON /bb_opal_z/ : some indices & abundances for T6,R and C,O interpolation
c
c /bb_opal_z/: --> data{ALL}
      common/bb_opal_z/ xodp,xcdp,xxco,cxx,oxx,
     $     l1,l2,l3,l4,k1,k2,k3,k4,ip,iq(4),kzf,kzg,kzh,kzf2
      save /bb_opal_z/
c
c COMMON /c_pot_indices/ : indices for Potekhin 2006 conductive opacities
c
c /c_pot_indices/: --> data{ALL}
      common /c_pot_indices/ zkpot(0:3,0:3), zlg_pot_p, i1pot_p,
     $     i4pot_p, j1pot_p, j4pot_p, i1pot, i2pot, i3pot, i4pot,
     $     j1pot, j2pot, j3pot, j4pot, k1pot, k2pot, k3pot, k4pot
      save /c_pot_indices/
c
c COMMON /e_opal_z/ : variables returning opacity values, as described above
c
c /e_opal_z/: --> data{ALL}
      common/e_opal_z/ opact,dopact,dopacr,dopactd,fedge,ftredge,fzedge
      save /e_opal_z/
c
c COMMON /x_opal_z/ : variables containing stored OPAL_F_CNOU input values
c  
c /x_opal_z/: --> data{ALL}
      common /x_opal_z/ z_opal, x_opal, xc_opal, xo_opal, slt_opal,
     $     slr_opal, fcn_opal, fcon_opal, fcnone_opal, fu_opal
      save /x_opal_z/
c
c COMMON /recoin_opal_z/ :
c  itimeco = 12345678 after initializations have been carried out (init-flag)
c  mxzero = 1 is set to the X-index of the mix with X=0
c  mx03 = 2 is set to the X-index of the mix with X=0.03
c  kope is the length of the directory-name (where the opacity files are)
c  igznotgx is a flag to tell whether the OPAL opacity file names are in the
c            new form  Gz???.x??  rather than the old form  Gx??z*
c            (initially,  igznotgx = 0  meaning "look for either")
c
c /recoin_opal_z/: --> data{ALL}
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c
c COMMON /alt_change_opal_z/ :
c  main_alt_change = 0 unless a new file has been set to replace 'GS98hz'
c  iulow = 23 (by default) = the beginning Fortran unit number for reading
c            opacity files; Fortran units iulow through iulow + 3 may be used.
c  khighz_in = khighz value used when reading opacities.
c  ofebrack_in = [O/Fe] value used when reading opacities.
c
c /alt_change_opal_z/: --> data{ALL}
      common /alt_change_opal_z/ main_alt_change, iulow, khighz_in,
     $     ofebrack_in
      save /alt_change_opal_z/
c
c PARAMETERS defining the matrices used to hold the mix compositions:
c  nel_zmix = 19 = number of heavy elements in the opacity mixture (C thru Ni)
c  n_zmixes = 5 = number of "hz" opacity files available (the fifth one is for
c                  a user-supplied "hz" opacity file, with non-zero [O/Fe])
c  kel_o = 3 = position of oxygen (O) in the list of mix-elements
c  kel_fe = nel_zmix-1 = 18 = position of iron (Fe) in the list of mix-elements
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
c COMMON /opalmixes/ : makeup of Z in opacity mixtures (described above):
c
c-SIZE 4*((2*nel_zmix+2)*n_zmixes+3*nel_zmix)+2*nel_zmix+8*n_zmixes = 0.001 Mb
c
c /opalmixes/: --> data{ALL BUT xofe_opalmixes}
c-implicit;      real*4 xiz_mix,fninz_mix,bracketife_mix,bracketofe_opalmixes,
c-implicit;     $     xofe_opalmixes,xiz_opalmixes,fninz_opalmixes
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
c  n_totmix = 10 = n_zmixes + 5 = number of "GS98hz" opacity files available,
c                                   plus 5 more files for CNO-interpolation and
c                                   user-specified interpolation.
c  n_cnobeg = 6 = n_zmixes + 1 = position of first CNO-interpolation filename,
c                                   usually the same as the default mix used
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
c COMMON /opalGS98mixes/ : makeup of Z in GS98 opacity mixtures (see above):
c
c-SIZE 4*(2*(n_totmix+1)*(nel_zmix+1)+nel_zmix) + 255*(n_totmix+1) = 0.004 Mb
c
c /opalGS98mixes/: --> data{ALL BUT xofe_opalGS98}
c-implicit;      real*4 bracketofe_opalGS98, xofe_opalGS98, xiz_opalGS98,
c-implicit;     $     fninz_opalGS98, atwt_opalGS98
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
c COMMON /c_meteor_mix_opal_z/ : meteoritic mixes for GN93, GS98, AGS04
c
c-SIZE 4*(2*nel_zmix*n_mix_meteor+nel_zmix) + 255*n_mix_meteor = 0.001 Mb
c
c /c_meteor_mix_opal_z/: --> data{ALL}
      parameter ( n_mix_meteor = 3 )
      double precision xiz_meteor, fninz_meteor
      character*255 cfile_meteor(n_mix_meteor)
      common /c_meteor_mix_opal_z/ xiz_meteor(nel_zmix,n_mix_meteor),
     $     fninz_meteor(nel_zmix,n_mix_meteor),
     $     nuc_charge_opalmixes(nel_zmix), cfile_meteor
      save /c_meteor_mix_opal_z/
c
c COMMON /c_mixfiles_used_opal_z/ : meteoritic mixes for GN93, GS98, AGS04
c
c-SIZE 255*(n_totmix+2) = 0.003 Mb
c
c /c_mixfiles_used_opal_z/: --> data{ALL}
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c
c COMMON /ext_CNO_opal_z/ : default extensions for CNO-interpolation files:
c
c-SIZE (80+4)*(n_totmix-n_cnobeg+1) = 0.0004 Mb
c
c /ext_CNO_opal_z/: --> data{ALL}
      character*80 cdef_CNO_ext(n_cnobeg:n_totmix)
      common /ext_CNO_opal_z/ len_def_CNO_ext(n_cnobeg:n_totmix),
     $     cdef_CNO_ext
      save /ext_CNO_opal_z/
c
c PARAMETERS defining the matrices used for the Z-interpolation:
c  mz = 8 = number of metallicities Z available in the 'Gz???.x??' files
c  mzhi = 11 = number of Z-indices for the mix-number matrix nofz (see below)
c  mzal = 13 = number of metallicities Z available in the 'GN93hz' file
c  nzm = 14 = combined total number of metallicities Z available in files
c  nadd_zavail = 6 = number of metallicities Z besides those in 'Gz???.x??'
c
      parameter ( mz=8, mz_m1=mz-1, mz_m2=mz-2, mzhi=11, mzal=13,
     $     nzm=mzal+1, nadd_zavail=nzm-mz )
c
c COMMON /zinter_opal_z/ : values used in Z-interpolation:
c  zvalhi(mzhi) = Z-range limits for the mix-number matrix nofz (see below)
c  nofz(mzhi,5,mo) = the number of different C-tables at each O-tabulation and
c                     X-tabulation value, for each relevant range of Z
c  mnofz(mx) = X-table m-index in nofz corresponding to the m-index in xa(mx):
c               if the X-table abundances in xa are unchanged,  mnofz(i) = i
c  zval(mz) = Z-tabulation values available in the 'Gz???.x??' files
c  zalval(mzal) = Z-tabulation values available in the 'GN93hz' file
c  zavail(nzm) = combined Z-tabulation values available in the files
c  iadd_zavail(nadd_zavail) = best order in which to reduce the intervals in
c                              zval() by adding metallicities from zavail()
c
c /zinter_opal_z/: --> data{ALL}
      common/zinter_opal_z/ zvalhi(mzhi),nofz(mzhi,5,mo),mnofz(mx),
     $     zval(mz),zalval(mzal),zavail(nzm),iadd_zavail(nadd_zavail)
      save /zinter_opal_z/
c
c COMMON /czinte_opal_z/ : the X- and Z- parts of the 'Gx??z*' file names;
c                          also used to specify the 'Gz???.x??' file names:
c
c /czinte_opal_z/: --> data{ALL}
      character*4 cxfil(5),czfil(mz)
      common/czinte_opal_z/ cxfil,czfil
      save /czinte_opal_z/
c
c COMMON /c_opal_ctrl_smooth/ : flags to control the opacity smoothing:
c  init_smo = 0 : do not smooth the opacities on input
c           = 1 : on input, subroutine OPALTAB smooths the opacities, but do
c                  NOT smooth the CNO-interpolation opacity deltas
c           = 2 (default): on input, subroutine OPALTAB smooths the opacities,
c                  including those used to get the CNO-interpolation deltas
c  low_CO_smo = 0 : do not perform this CO-direction smoothing
c             = 1 (default): on input, a few opacities in the 3 mixes adjacent
c                    to the C=O=0.0 mix (i.e., the 3 mixes with C or O = 0.01,
c                    C+O no more than 0.02) are smoothed in the C-O direction,
c                    if opacity changes between mixes with C,O = 0.0, 0.03, 0.1
c                    are monotonic but the opacity at C,O = 0.01 does not fit
c                    the trend; the resulting adjustments are small, and only
c                    occur at a small minority of the (T6,R) points
c  interp_CO_smo = 0 : use the old subroutine COINTERP for interpolating among
c                       CO-rich opacities when OPAC or OPAL is called
c                = 1 (default): use the new subroutine COINTSMO instead, for
c                       smoother interpolation among CO-rich opacities
c
c /c_opal_ctrl_smooth/: --> data{ALL}
      common/c_opal_ctrl_smooth/ init_smo, low_CO_smo, interp_CO_smo
      save /c_opal_ctrl_smooth/
c
c COMMON /opdir/ : copdir = the name of the directory holding opacitythe files;
c  here it is initialized to be blank, meaning "use the current directory".
c
c /opdir/: --> data{copdir}
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c
c PARAMETERS defining storage for the molecular opacities
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
c COMMON /mat_alex_ferg/ : storage for molecular opacities
c  flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg) : storage for Ferguson et al. 2005
c                                                           molecular opacities
c  flk_alex(nrlo_alex:nr_alex,nt_alex,nzp1_alex,nx_alex) : alternatively, this
c                                                           equivalenced matrix
c                           holds Alexander & Ferguson 1994 molecular opacities
c
c-SIZE 4*nr_ferg*nt_ferg*nz_ferg*nx_ferg = 0.986 Mb
c
      common /mat_alex_ferg/ flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg)
      save /mat_alex_ferg/
      dimension flk_alex(nrlo_alex:nr_alex,nt_alex,nzp1_alex,nx_alex)
      equivalence (flk_alex(nrlo_alex,1,1,1),flk_ferg(1,1,1,1))
c
c COMMON /opac_alex/ : logX,logZ for Alexander 1994 molecular opacities
c
      common /opac_alex/ zlog_alex(nzp1_alex),xlog_alex(nx_alex),
     $     dzinvlog_alex(nzp1_alex),dxinvlog_alex(nx_alex)
      save /opac_alex/
c
c COMMON /opac_ferg/ : logZ,logX,logT6,logR for Ferguson et al. 2005 opacities
c
c-SIZE 4*(nzp1_ferg+3*nx_ferg+2*nz_ferg+2*nt_ferg+2*nr_ferg+3) = 0.001 Mb
c
      common /opac_ferg/ zlog_ferg(nzp1_ferg), xlog_ferg(nx_ferg),
     $     dzinvlog_ferg(nz_ferg), dzinv_ferg(nz_ferg),
     $     dxinvlog_ferg(nx_ferg), dxinv_ferg(nx_ferg),
     $     t6log_ferg(nt_ferg), rlog_ferg(nr_ferg),
     $     dt6inv_ferg(nt_ferg), drinv_ferg(nr_ferg),
     $     modt_ferg, modz0_ferg, ntuferg
      save /opac_ferg/
c
c COMMON /c_ini_ferg/ : Z, X, logT, and logR grids for Ferguson 2005 opacities
c  z_ferg(nz_ferg) = the 16 Z-values, for each Z-index
c  x_ferg(nx_ferg) = the 10 X-values, for each X-index
c  iacc_ferg = 1 (default): handle big opacity-jumps at low T better, 0: don't
c  igot_t_ferg = 0: logT-values have not yet been read in, 1: they have been
c  igot_r_ferg = 0: logR-values have not yet been read in, 1: they have been
c  itype_ferg = index of Ferguson 2005 opacity type that was last read in:
c                   1 = case specified by CFILE_ALEX (see SET_ALEX_FILE),
c                   2 = GN93 case,      3 = GS98 case,      4 = L03 case,
c                   5 = AGS04 case,     6 = S92 case,       7 = S92AE case,
c                   8 = GS98-.2 case,   9 = GS98+.2 case,  10 = GS98+.4 case,
c                  11 = GS98+.4 case,  12 = GS98+.8 case,
c                  99 = user-specified case (see SET_FERG_USER).
c  lsep_ferg = length of Ferguson 2005 separator string csep_ferg (default 1)
c  lext_ferg = length of Ferguson 2005 extension string cext_ferg (default 4)
c  ltype_ferg(ntyp1_ferg) = lengths of typenames in ctype_ferg()
c  itype_def_ferg(ntyp1_ferg) = indices to try if cannot match OPAL opacities
c  ione_ferg(ntyp1_ferg) = 1 if <type>.one.tron exists, 0 if <type>.10.0.tron,
c                         -1 if this is not known
c  lz_ferg(nz_ferg) = lengths of Z-specifications in cz_ferg()
c  lx_ferg(nx_ferg) = lengths of X-specifications in cx_ferg()
c  cz_ferg(nz_ferg) = Z-specifications in filename for each Z-index
c  cx_ferg(nx_ferg) = X-specifications in filename for each X-index
c  ctype_ferg(ntyp1_ferg) = Ferguson 2005 typenames for indices 2 to ntype_ferg
c  csub_ferg(ntyp1_ferg) = subdirectories to check for corresponding files
c  csep_ferg = Ferguson 2005 separator string (default '.')
c  cext_ferg = Ferguson 2005 extension string (default 'tron')
c
c-SIZE 4*(3*ntyp1_ferg+2*nz_ferg+2*nx_ferg+6) + 80*(2*ntyp1_ferg+2)
c      + 5*(nz_ferg+nx_ferg) = 0.002 Mb
c
c /c_ini_ferg/: --> data{ALL}
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
c COMMON /c_ofe_in_ferg/ : For Ferguson et al. 2005 opacities: non-zero [O/Fe]
c                            and its mix-index, and mix-index for corresponding
c                            mix with [O/Fe] = 0 (for 's92ae' and 's92')
c Note: if g98 gs98-.2 gs98+.2 gs98+.4 ... are found, they will be used instead
c
c /c_ofe_in_ferg/: --> data{ALL}
      common /c_ofe_in_ferg/ ofein_ferg, i_ofe_ferg, i_ofe0_ferg
      save /c_ofe_in_ferg/
c
c COMMON /c_prev_ferg/ : specifications for cached Z,X-interpolated Ferguson et
c                               al. 2005 opacities (Z, X, T-range, and R-range)
c /c_prev_ferg/: --> data{ALL}
      common /c_prev_ferg/ zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $     zlp2_ferg, xp2_ferg, i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
      save /c_prev_ferg/
c
c COMMON /c_tsw_ferg/ : switchover factors OPAL <--> Ferguson et al. 2005
c  default: logT6 values corresponding to flt_max_ferg = 4.5 ,
c           fltswlo_ferg_def = 4.2 , fltswhi_ferg_def = 4.4
c
c /c_tsw_ferg/: --> data{ALL}
      common /c_tsw_ferg/ slt_max_ferg, sltswlo_ferg_def,
     $     sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $     sltswmid_ferg, dltsw2inv_ferg
      save /c_tsw_ferg/
c
c COMMON /c_ini_alex/ : Z, X, logT, and logRHO grids for Alexander opacities
c
c /c_ini_alex/: --> data{ALL}
      common /c_ini_alex/ z_alex(nzp1_alex),x_alex(nx_alex),
     $     flt_alex(nt_alex),flro_alex(nrlo_alex:nr_alex)
      save /c_ini_alex/
c
c COMMON /c_filename_alex/ :
c  need_alex_dir = 1 if directory in copdir should be prepended, 0 if not
c  cfile_alex = filename (possibly including directory) from which to read
c                 molecular opacities (DEFAULT: blank); for Ferguson 2005 case,
c                 any characters following the directory specification are
c                 interpreted as the beginning of the Ferguson filename
c                 (e.g., 'g', 'g98.', 'l03.', 'ags04.', 's92.', or 's92ae.'),
c                 unless overridden by input flag  ktype_ferg  in subroutine
c                 read_add_ferg  (in which case these characters are ignored)
c
c /c_filename_alex/: --> data{ALL}
      character*255 cfile_alex
      common /c_filename_alex/ need_alex_dir, cfile_alex
      save /c_filename_alex/
c
c COMMON /c_got_alex/ :
c  kavail_alex = 0 (default) if molecular opacities have not been read in;
c              = 1 if Alexander 1994 opacities have been read in (e.g., by the
c                    user calling the subroutine READALEX) and are available,
c              = 2 if Ferguson et al. 2005 opacities have been read in.
c  kuse_alex = 0 or less if Alexander opacities should NOT be used by the OPAL
c                  opacity-calculating routines, even if they are read in;
c            = 1 : (DEFAULT) For the Ferguson et al. 2005 opacities, the Z-edge
c                    factor FZKAEDGE is unity for XZCO < 0.10 at all X, and
c                    goes to zero for XZCO > 0.12; but for the Alexander 1994
c                    opacities, FZKAEDGE is unity for X = 0 at all XZCO and for
c                    XZCO < 0.10 at all X, and it goes to zero at XZCO > 0.15
c                    and X > 0.03 (note that XZCO = 1 - X - Y = Z + exC + exO).
c            = 2 : For Ferguson et al. 2005, same as kuse_alex = 1; but for
c                    Alexander 1994, FZKAEDGE goes to zero for XZCO > 0.15 at
c                    all X.
c            = 3 : For Ferguson et al. 2005, same as kuse_alex = 1; but for
c                    Alexander 1994, restrict to the regions where tables were
c                    available (not extrapolated or otherwise created):
c                      FZKAEDGE = 1.0 for 0.0001 < XZCO < 0.03, and goes to
c                      FZKAEDGE = 0.0 for XZCO < 0.00005 or XZCO > 0.05 .
c            = 4 : FOR THE OPAL-OPACITY-CALCULATING SUBROUTINES and KAPFERG:
c                    for BOTH the Ferguson et al. 2005 and the Alexander 1994
c                    cases: multiply the FZKAEDGE value from case 3 above by a
c                    factor that is unity if  exC  and  exO  are both zero,
c                    and which goes to zero if  abs(exC) + abs(exO) > CO_lim
c                    for  CO_lim = 0.2 * max( Z , 0.0001 , Z + exC + exO ) .
c                    [Note that this constraint cannot be applied in KAPALEX,
c                    which does not know the separate values of Z, exC, exO
c                    (but only their sum XZCO); thus, for calls to KAPALEX
c                    itself, KALEX = 4 has the same effect as KALEX = 3.]
c            = -1 thru -4 : molecular opacities should NOT be used by the OPAL
c                    opacity-calculating routines, even if they are read in;
c                    same as 1 thru 4 when KAPFERG is called explicitly;
c                    same as 1 thru 3 when KAPALEX is called explicitly.
c  kdo_alex = kuse_alex * min{1,kavail_alex}, i.e., "should they be used now?":
c           = 0 or less if molecular opacities should not be used "now";
c           = 1 or more if molecular opacities should be used "now".
c  iualex = Fortran unit number (default 23) for reading Alexander opacities
c
c /c_got_alex/: --> data{ALL}
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
c COMMON /c_trho_sw_alex/ :
c  fltswlo_alex_def THRU fltswhi_r_alex_def : storage for default values
c  fltswlo_alex, fltswhi_alex = logT boundaries of Alexander/OPAL switchover
c                                 (default logT = 3.87, 3.97)
c  fltswmid_alex = ( fltswhi_alex + fltswlo_alex ) / 2.0 = logT midpoint
c  dltsw2inv_alex = 4.0 / ( fltswhi_alex - fltswlo_alex )**2
c  sltswhi_alex = fltswhi_alex - 6.0
c  flrhoswlo_alex, flrhoswhi_alex = logRHO boundaries of switchover at high RHO
c                                     (default logRHO = -6.25, -5.75)
c  flrhoswmid_alex = ( flrhoswhi_alex + flrhoswlo_alex ) / 2. = logRHO midpoint
c  dlrhosw2inv_alex = 4.0 / ( flrhoswhi_alex - flrhoswlo_alex )**2
c  fltswlo_r_alex, fltswhi_r_alex = logT boundaries of high-RHO switch-off
c                                     (default logT = 3.70, 3.80)
c  fltswmid_r_alex = ( fltswhi_r_alex + fltswlo_r_alex ) / 2.0 = logT midpoint
c  dltsw2inv_r_alex = 4.0 / ( fltswhi_r_alex - fltswlo_r_alex )**2
c  sltswlo_alex = fltswlo_alex - 6.0
c  isw_rho_alex = flag to tell whether to do the switchover to OPAL at high RHO
c
c /c_trho_sw_alex/: --> data{ALL}
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
c COMMON /c_edge_alex/ :
c
      common /c_edge_alex/ fkaedgelo, fkaedgehi, fzkaedge
      save /c_edge_alex/
c
c PARAMETERS defining storage for Potekhin et al 2006/2007 conductive opacities
c
c  nT_KcPot = 19 : number of T-values
c  nR_KcPot = 64 : number of RHO-values
c  nZ_KcPot = 15 : number of Zion values
c
      parameter ( nT_KcPot=19, nR_KcPot=64, nZ_KcPot=15 )
c
c PARAMETERS defining storage for the Hubbard & Lampe 1969 conductive opacities
c
c  nthikc = 90 - ntlokcm1 = 90 - (37-1) = 54 : number of T-values
c  nrhikc = 24 - nrlokcm1 = 24 - (-23-1) = 48 : number of RHO-values
c  nkc= 3 : number of elements (H, He, and C)
c
      parameter ( ntlokc=37, ntlokcm1=ntlokc-1, nthikc=90-ntlokcm1,
     $     nrlokc=-23, nrlokcm1=nrlokc-1, nrhikc=24-nrlokcm1, nkc=3,
     $     nthikcm1=nthikc-1, nrhikcm1=nrhikc-1, nkcp1=nkc+1 )
      parameter ( dlt_kc=.1, dlr_kc=.25, dltinv_kc=10., dlrinv_kc=4. )
c
c COMMON /c_flkcond_hlpot/ : storage for H&L or Potekhin conductive opacities
c
c-SIZE 4*(nT_KcPot*nR_KcPot*nZ_KcPot+3*nrhikc*nkc+nkc) + 2*nkc = 0.071 Mb
c
      character*2 celkc_hl(nkc)
      common /c_flkcond_hlpot/ flkc_pot(nT_KcPot,nR_KcPot,nZ_KcPot),
     $     AT_pot(nT_KcPot), AR_pot(nR_KcPot), AZ_pot(nZ_KcPot),
     $     sigconlog_pot, itlo_hl(nrhikc,nkc), ithi_hl(nrhikc,nkc),
     $     irhi_hl(nkc), itlo_ok_hl(nrhikc,nkc),
     $     irjump_hl(nkc), celkc_hl
      save /c_flkcond_hlpot/
c
      dimension flkc_hl(nthikc,nrhikc,nkc),
     $     flrolo_hl(nkc), flrohi_hl(nkc),
     $     fltlo_hl(nkc), flthi_hl(nkc),
     $     flRlo_hl(nkc), flRhi_hl(nkc), kZ_pot(nZ_KcPot)
      equivalence (flkc_pot(1,1,1),flkc_hl(1,1,1)),
     $     (AR_pot(1),flrolo_hl(1)), (AR_pot(nkcp1),flrohi_hl(1)),
     $     (AT_pot(1),fltlo_hl(1)), (AT_pot(nkcp1),flthi_hl(1)),
     $     (AZ_pot(1),flRlo_hl(1)), (AZ_pot(nkcp1),flRhi_hl(1)),
     $     (itlo_hl(1,1),kZ_pot(1))
c
c COMMON /c_got_cond/ : flags for availability of conductive opacities
c
c  If itoh_gap = 1 (default) in data statement below, then high-density Itoh
c   conductive opacities are used in the mid-RHO,low-T "gap" to improve the H&L
c   opacities there (beyond the edge of the H&L tables) in order to improve the
c   H&L-to-Itoh switchover at increasing density and low temperature (note that
c   no input H&L values are modified, only the extrapolation region).
c   If itoh_gap = 0, this is not done: the H&L tables are just extrapolated.
c  If ifix_h_cond > 0 (default), then remove an anomalously low Hydrogen
c   conductive opacity value (at logT = 5.4, logRHO = -0.5).
c  If kavail_cond = 0, NO conductive opacities were read in;
c   If kavail_cond = 1, 'Condopac' was read in (H&L, can be extended by Itoh);
c   If kavail_cond = 2, 'condall06.d' was read in (Potekhin et al. 2006)
c  Note that  itoh_replace  (default 99) is set via SET_COND_USE.
c  itoh_replace_max = max useful value of itoh_replace (presently 0 or 2).
c
c /c_got_cond/ : --> data{ALL}
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
c COMMON /c_filename_cond/ : filename containing conductive opacities
c
      parameter ( ndef_cond = 3 )
c
c /c_filename_cond/ : --> data{ALL}
      character*255 cfile_cond
      character*80 cdef_cond(ndef_cond)
      common /c_filename_cond/ need_cond_dir, cfile_cond, cdef_cond
      save /c_filename_cond/
c
c COMMON /c_kcond_itoh/ : parameters of Itoh conductive opacity formulae
c
c /c_kcond_itoh/ : --> data{ALL}
      parameter ( nitoh=5, nhl=4 )
      common /c_kcond_itoh/ ai_kc(nitoh), ax_kc(0:3,nitoh,3),
     $     bx_kc(0:2,nitoh,3), cx_kc(0:2,nitoh,3)
      save /c_kcond_itoh/
c
c COMMON /alink_opal_z/ : contains data needed for smoothing routine OPALTAB
c
c-SIZE 4*((nrm+1)*100+5) = 0.008 Mb
c
      common/alink_opal_z/ NTEMP,NSM,nrlow,nrhigh,RLE,t6arr(100),
     $     coff(100,nrm)
      save /alink_opal_z/
c
c COMMON /d_opal_z/ :
c  dkap = derivative of value returned by quadratic interpolation function QDER
c
c /d_opal_z/: --> data{dkap}
      common/d_opal_z/ dkap
      save /d_opal_z/
c
c COMMON /c_level_err_opal_z/ :
c  level_err = error-checking level, set by SET_ERR_CHECK; allowed values are:
c                0 : Do not check input Nzin, Zlo, Z, Zhi in READZEXCO.
c                1 : (Default): Do check these; fatal error if checks fail.
c                2 : In this case, it is also a fatal error if FEDGE = 0.
c                3 : In this case, it is also a fatal error if CNO-interp files
c                      have been read in and you call OPAL_X_CNO_U with a metal
c                      composition array of size other than 19.
c
c /c_level_err_opal_z/: --> data{level_err}
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
c COMMON /c_level_list_opal_z/ :
c  iu_list = 6 by default: Fortran unit to which to list opacity file names.
c  level_list = 0 : (default) do not list the names of opacity files read in;
c             = 1 : Output each Type 1 OPAL, conductive, or Alexander opacity
c                    file read in, and one of each case of Type 2 OPAL or
c                    Ferguson opacity file read in;
c             = N > 1 : same as 1, except output N of each case of Type 2 OPAL
c                        or Ferguson opacity file read in.
c  list_mult : counter for Type 2 OPAL (Gz???.x?? files), Ferguson, conductive,
c               or Alexander opacity file listings.
c  list_gn(-n_zmixes:n_totmix) : counters for Type 1 OPAL file listings.
c
c /c_level_list_opal_z/: --> data{all}
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c
c COMMON /c_ctab/
c  ctab = character*1 variable containing a tab character: needed only in order
c           to allow tabs in input files (and in character string argumentss)
c           to be interpreted as whitespace
c
c /c_ctab/: --> data{ctab}
      character*1 ctab
      common /c_ctab/ ctab
      save /c_ctab/
c
c COMMON /chkpoc/ :
c  cb = character(s) allowed to terminate a directory name [cb(1) and cb(2)],
c         and non-alphanumeric characters allowed in a filename [cb(3) thru 6].
c         DEFAULT (sun/iris/linux): cb(1:2) = '/', cb(3:6) = '_', '~', '+', '-'
c         VMS (must edit data statement): cb(1:2) = ':', ']', cb(3:6) = ';'
c
c /chkpoc/: --> data{cb}
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
c COMMON /outdeb/ : controls the extent of error and debugging output, if the
c                    debug statements are un-commented by removing "c-debug;"
c                    at the beginning of the relevant lines 
c   if a log10(opacity) value is > oudebl, then the relevant debug output is
c                    performed (provided that it is not commented out)
c   else if ioudeb > 0 , then debug output is performed; higher values of
c                    ioudeb yield more output (unless it is commented out)
c   koudeb counts how many debug outputs have been performed (e.g., so that
c           you can set ioudeb = -1 or increase oudebl after a given number
c           of debug outputs have been performed)
c-debug[
      common/outdeb/ ioudeb,oudebl,koudeb
c-debug;c
      data ioudeb/-1/,oudebl/15./,koudeb/0/
c-debug]
c
c NOTE that any lines commented out with "c-debug-chk;" correspond to cases
c  where output is NOT controlled by the variables in common/outdeb/ ; if
c  these statements are un-commented by removing "c-debug-chk;" then the
c  relevant output will occur whenever the subroutine READZEXCO is called.
c
c NOTE that lines commented out with "c-test-xdel;" correspond to code which
c  tests the effect of changing the value of xdel, the offset for logarithmic
c  X-interpolation.  There are some such cases in the subroutine OPAL, for
c  tests of interpolation among the mixes with X-values xa(m), and some in
c  the subroutine READZEXCO, for tests of interpolation among the 'GN93hz'
c  mixes with X = 0.0, 0.1, and 0.2 in order to get the mix with X = 0.03
c  (the latter produce output similar to that from "c-debug-chk;" lines).
c
c---
c
c /xhi_opal_z/ data:
c
      data xhi_in / 0., 0.1, 0.2, 0.35, 0.5, 0.7, 0.8, 0.9, 0.95, 1. /
      data xcno_use / mx_hi_nz * -1.0 /, xhi_use / mx_hi_nz * -1.0 /
      data xxx_cno / mx_hi * -9.0 /, xxx_hi / mx_hi * -9.0 /
      data nx_hi / nz * 0 /
      data ireq_hi / 0, 0, 1, 0, 1, 0, 1, 1, 1, 1 /
      data khighx / nz * 0 /
      data kavail_xhi / 0 /, kuse_xhi / 2 /, kdo_xhi / 0 /
      data kavail_cno / 0 /, kuse_cno / 1 /, kdo_cno / 0 /
      data kavail_user / 0 /, kuse_user / 1 /, kdo_user / 0 /
c
c /a_opal_z/ data:
c								! indx(1:101)
      data indx/1,2,2,3,3,3,3,3,3,3,4,4,4,4,4,4,
     $     4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,6,6,6,6,6,
     $     6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
     $     7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7/
c								! X(1:mx) mx=5
      data xa/ 0.0, 0.03, 0.1, 0.35, 0.7, 3 * 0.0 /
c								! C,O(1:mc)
      data xcs/0.0,0.01,0.03,0.1,0.2,0.4,0.6,1.0/
      data xos/0.0,0.01,0.03,0.1,0.2,0.4,0.6,1.0/
c								! init-flag
      data itime / 0 /
c
c /b_opal_z/ data:
c								! nta(0:nrm_p1)
      data nta/57, 70,70,70,70,70, 70,70,70,70,70,
     $     70,70,70,70,69, 64,60,58,57, -99/
c								! ntax0(0:nrm)
      data ntax0/999, 6,5,5,5,4, 4,4,3,1,1, 1,1,1,1,1, 1,1,1,1/
c								! ntax03(0:nrm)
      data ntax03/999, 5,1,1,1,1, 1,1,1,1,1, 1,1,1,1,1, 1,1,1,1/
c
      data sltlo/-99./, slthi/-99./, dltlo_inv/-99./, dlthi_inv/-99./
      data slrlo/-99./, slrhi/-99./, dlrlo_inv/-99./, dlrhi_inv/-99./
      data init_trvals/0/
c
c /bb_opal_z/ data:
c
      data xodp / 0.0 /, xcdp / 0.0 /, xxco / 0.0 /
      data cxx / 0.0 /, oxx / 0.0 /
      data l1 / 1 /, l2 / 2 /, l3 / 3 /, l4 / 4 /
      data k1 / 1 /, k2 / 2 /, k3 / 3 /, k4 / 4 /
      data ip / 3 /, iq / 4 * 3 /
      data kzf / 1 /, kzg / 1 /, kzh / 1 /, kzf2 / 1 /
c
c /c_pot_indices/ :
c
      data zkpot / 16 * 0.0 /, zlg_pot_p / -1.e30 /
      data i1pot_p / 0 /, i4pot_p / -1 /, j1pot_p / 0 /, j4pot_p / -1 /
      data i1pot / 1 /, i2pot / 2 /, i3pot / 3 /, i4pot / 4 /
      data j1pot / 1 /, j2pot / 2 /, j3pot / 3 /, j4pot / 4 /
      data k1pot / 1 /, k2pot / 2 /, k3pot / 3 /, k4pot / 4 /
c
c /e_opal_z/ data:
c
      data opact/1.e35/, dopact/0./, dopacr/0./, dopactd/0./,
     $     fedge/0./, ftredge/0./, fzedge/0./
c
c /x_opal_z/ data:
c
      data z_opal / -1.0 /, x_opal / -1.0 /, xc_opal / -1.0 /
      data xo_opal / -1.0 /, slt_opal / -99.0 /, slr_opal / -99.0 /
      data fcn_opal / 0.0 /, fcon_opal / 0.0 /, fcnone_opal / 0.0 /
      data fu_opal / 0.0 /
c
c /recoin_opal_z/ data:
c
      data itimeco/0/, mxzero/1/, mx03/2/, kope/0/, igznotgx/0/
c
c /alt_change_opal_z/ data:
c
      data main_alt_change / 0 /, iulow / 23 /, khighz_in / 0 /,
     $     ofebrack_in / 0.0 /
c
c /opalmixes/ data:
c
      data cfile_opalmixes/'GN93hz  ','Alrd96a2','C95hz   ','W95hz   ',
     $     'W95hz   '/
      data cel_opalmixes/'C ','N ','O ','Ne','Na','Mg','Al','Si',
     $     'P ','S ','Cl','Ar','K ','Ca','Ti','Cr','Mn','Fe','Ni'/
      data xiz_opalmixes/
     $     0.173285,0.053152,0.482273,0.098668,0.001999,
     $     0.037573,0.003238,0.040520,0.000355,0.021142,
     $     0.000456,0.005379,0.000210,0.003734,0.000211,
     $     0.001005,0.000548,0.071794,0.004459,
     $     0.102693,0.031499,0.570253,0.116656,0.002363,
     $     0.044428,0.000962,0.047912,0.000420,0.024999,
     $     0.000539,0.006360,0.000124,0.004415,0.000245,
     $     0.000595,0.000230,0.042538,0.002769,
     $     0.091924,0.028196,0.642620,0.052341,0.001060,
     $     0.050066,0.001718,0.053992,0.000188,0.028172,
     $     0.000242,0.002853,0.000279,0.004975,0.000275,
     $     0.000533,0.000116,0.038085,0.002365,
     $     0.076451,0.023450,0.672836,0.084869,0.000882,
     $     0.041639,0.001428,0.035669,0.000157,0.019942,
     $     0.000201,0.002373,0.000092,0.005209,0.000387,
     $     0.000443,0.000242,0.031675,0.002056,
     $     0.173285,0.053152,0.482273,0.098668,0.001999,
     $     0.037573,0.003238,0.040520,0.000355,0.021142,
     $     0.000456,0.005379,0.000210,0.003734,0.000211,
     $     0.001005,0.000548,0.071794,0.004459/
      data xiz_mix/
     $     0.173285,0.053152,0.482273,0.098668,0.001999,
     $     0.037573,0.003238,0.040520,0.000355,0.021142,
     $     0.000456,0.005379,0.000210,0.003734,0.000211,
     $     0.001005,0.000548,0.071794,0.004459/
      data fninz_opalmixes/
     $     0.245518,0.064578,0.512966,0.083210,0.001479,
     $     0.026308,0.002042,0.024552,0.000195,0.011222,
     $     0.000219,0.002291,0.000091,0.001586,0.000075,
     $     0.000329,0.000170,0.021877,0.001293,
     $     0.147909,0.038904,0.616594,0.100010,0.001778,
     $     0.031622,0.000617,0.029512,0.000234,0.013490,
     $     0.000263,0.002754,0.000055,0.001906,0.000089,
     $     0.000198,0.000072,0.013177,0.000816,
     $     0.131157,0.034498,0.688325,0.044451,0.000790,
     $     0.035301,0.001091,0.032945,0.000104,0.015059,
     $     0.000117,0.001224,0.000122,0.002127,0.000099,
     $     0.000176,0.000036,0.011687,0.000691,
     $     0.108211,0.028462,0.714945,0.071502,0.000652,
     $     0.029125,0.000900,0.021591,0.000086,0.010575,
     $     0.000096,0.001010,0.000040,0.002210,0.000137,
     $     0.000145,0.000075,0.009642,0.000595,
     $     0.245518,0.064578,0.512966,0.083210,0.001479,
     $     0.026308,0.002042,0.024552,0.000195,0.011222,
     $     0.000219,0.002291,0.000091,0.001586,0.000075,
     $     0.000329,0.000170,0.021877,0.001293/
      data fninz_mix/
     $     0.245518,0.064578,0.512966,0.083210,0.001479,
     $     0.026308,0.002042,0.024552,0.000195,0.011222,
     $     0.000219,0.002291,0.000091,0.001586,0.000075,
     $     0.000329,0.000170,0.021877,0.001293/
      data bracketife_mix/nel_zmix*0.0/
      data bracketofe_opalmixes/0.0,0.3,0.4,0.5,0.0/
c
c /opalGS98mixes/ data (note input-meteor abundances are initialized to zero):
c
      data bracketofe_opalGS98 / -0.48, 0.0, 0.3, 0.4, 0.5, 6 * 0.0 /
      data xiz_opalGS98 / nel_zmix * 0.0,
     $     0.171836, 0.050335, 0.467356, 0.104831, 0.002090,
     $     0.039924, 0.003603, 0.044057, 0.000423, 0.023513,
     $     0.000292, 0.004335, 0.000228, 0.003896, 0.000195,
     $     0.001117, 0.000779, 0.076433, 0.004757,
     $     0.101930, 0.029858, 0.553139, 0.124072, 0.002473,
     $     0.047252, 0.001071, 0.052144, 0.000501, 0.027829,
     $     0.000346, 0.005131, 0.000135, 0.004611, 0.000226,
     $     0.000663, 0.000327, 0.045339, 0.002955,
     $     0.091638, 0.026843, 0.626052, 0.055905, 0.001114,
     $     0.053480, 0.001921, 0.059017, 0.000226, 0.031497,
     $     0.000156, 0.002312, 0.000305, 0.005218, 0.000256,
     $     0.000596, 0.000165, 0.040761, 0.002537,
     $     0.076359, 0.022368, 0.656744, 0.090832, 0.000929,
     $     0.044563, 0.001601, 0.039063, 0.000188, 0.022339,
     $     0.000130, 0.001927, 0.000101, 0.005474, 0.000362,
     $     0.000496, 0.000346, 0.033965, 0.002214,
     $     0.171836, 0.050335, 0.467356, 0.104831, 0.002090,
     $     0.039924, 0.003603, 0.044057, 0.000423, 0.023513,
     $     0.000292, 0.004335, 0.000228, 0.003896, 0.000195,
     $     0.001117, 0.000779, 0.076433, 0.004757,
     $     nel_zmix * 0.0, nel_zmix * 0.0, nel_zmix * 0.0,
     $     nel_zmix * 0.0, nel_zmix * 0.0 /
      data fninz_opalGS98 /
     $     .062096387, .0043961031, .60683708, 2.15357e-10,
     $     .0052838595, .09398768, .0072952272, .087714215,
     $     .00069665492, .040091598, .00078239704, 8.77017e-10,
     $     .00032510563, .0056661265, .00026794421, .0011753819,
     $     .00060734018, .078157537, .0046193578,
     $     0.245825, 0.061748, 0.501922, 0.089265, 0.001562,
     $     0.028224, 0.002294, 0.026954, 0.000235, 0.012602,
     $     0.000141, 0.001865, 0.000100, 0.001670, 0.000070,
     $     0.000369, 0.000244, 0.023517, 0.001393,
     $     0.148069, 0.037193, 0.603216, 0.107280, 0.001877,
     $     0.033921, 0.000693, 0.032394, 0.000282, 0.015145,
     $     0.000170, 0.002241, 0.000060, 0.002007, 0.000082,
     $     0.000222, 0.000104, 0.014165, 0.000878,
     $     0.131883, 0.033128, 0.676395, 0.047890, 0.000838,
     $     0.038036, 0.001231, 0.036324, 0.000126, 0.016982,
     $     0.000076, 0.001000, 0.000135, 0.002251, 0.000092,
     $     0.000198, 0.000052, 0.012616, 0.000747,
     $     0.108877, 0.027349, 0.702986, 0.077089, 0.000692,
     $     0.031401, 0.001016, 0.023820, 0.000104, 0.011933,
     $     0.000063, 0.000826, 0.000044, 0.002339, 0.000129,
     $     0.000163, 0.000108, 0.010416, 0.000646,
     $     0.245825, 0.061748, 0.501922, 0.089265, 0.001562,
     $     0.028224, 0.002294, 0.026954, 0.000235, 0.012602,
     $     0.000141, 0.001865, 0.000100, 0.001670, 0.000070,
     $     0.000369, 0.000244, 0.023517, 0.001393,
     $     nel_zmix * 0.0, nel_zmix * 0.0, nel_zmix * 0.0,
     $     nel_zmix * 0.0, nel_zmix * 0.0 /
      data atwt_opalGS98 /
     $     12.01100, 14.00670, 15.99940, 20.17900, 22.98977,
     $     24.30500, 26.98154, 28.08550, 30.97376, 32.06000,
     $     35.45300, 39.94800, 39.09830, 40.08000, 47.90000,
     $     51.99600, 54.93800, 55.84700, 58.70000 /
      data cfile_opalGS98 / ' ', 'GS98hz', 'GS98hz_OFe.3_Alrd96a2',
     $     'GS98hz_OFe.4_C95', 'GS98hz_OFe.5_W95', 6 * ' ' /
c
c /c_meteor_mix_opal_z/ data:
c
      data xiz_meteor /
     $     .034055950767625d0, .002811584920288d0, .443326132928943d0,
     $     .000000000198429d0, .005546683967014d0, .104307149947153d0,
     $     .008987793491910d0, .112486310445815d0, .000985278857158d0,
     $     .058690042443895d0, .001266565623746d0, .000000001599745d0,
     $     .000580403334678d0, .010369588461345d0, .000586040222841d0,
     $     .002790592585741d0, .001523534791034d0, .199305017419850d0,
     $     .012381327992788d0,
     $     .033847976603222d0, .002794386850040d0, .440624098408040d0,
     $     .000000000197201d0, .005426796827570d0, .103667372071604d0,
     $     .009353799223261d0, .114401914525715d0, .001099992396139d0,
     $     .061056356041069d0, .000755439983010d0, .000000001590383d0,
     $     .000590861589288d0, .010115144589889d0, .000506712319369d0,
     $     .002899506965060d0, .002025771911462d0, .198476752244634d0,
     $     .012357115663043d0,
     $     .036009888957169d0, .002972903901491d0, .468754671183736d0,
     $     .000000000209847d0, .005109430493010d0, .098297263764627d0,
     $     .008666855488115d0, .108474558443967d0, .000929109426030d0,
     $     .055311919937648d0, .000717037689513d0, .000000001691848d0,
     $     .000537541819713d0, .009335779714580d0, .000446291259625d0,
     $     .002705854260520d0, .001935100559721d0, .188437270946424d0,
     $     .011358520252416d0 /
      data fninz_meteor /
     $     .062096387323045d0, .004396103132102d0, .606837084080657d0,
     $     .000000000215357d0, .005283859474681d0, .093987679773822d0,
     $     .007295227181013d0, .087714215091835d0, .000696654916553d0,
     $     .040091598026506d0, .000782397036934d0, .000000000877017d0,
     $     .000325105632923d0, .005666126529857d0, .000267944210671d0,
     $     .001175381889649d0, .000607340179662d0, .078157536632930d0,
     $     .004619357794785d0,
     $     .061833419528987d0, .004377442231746d0, .604274480285562d0,
     $     .000000000214427d0, .005179390157206d0, .093587138052187d0,
     $     .007606607490520d0, .089375982574740d0, .000779229621820d0,
     $     .041786601600009d0, .000467537763442d0, .000000000873527d0,
     $     .000331587065415d0, .005537504221631d0, .000232110957854d0,
     $     .001223556258112d0, .000809072444438d0, .077979330676706d0,
     $     .004619007981672d0,
     $     .064274208429525d0, .004550290959465d0, .628110449385059d0,
     $     .000000000222945d0, .004764660515098d0, .086704154588141d0,
     $     .006886347278212d0, .082801809933137d0, .000643083014308d0,
     $     .036987017004729d0, .000433593850556d0, .000000000907947d0,
     $     .000294746381558d0, .004993637042920d0, .000199745481717d0,
     $     .001115651593004d0, .000755135357710d0, .072337095427584d0,
     $     .004148372626387d0 /
      data nuc_charge_opalmixes / 6, 7, 8, 10, 11,  12, 13, 14, 15, 16,
     $     17, 18, 19, 20, 22,  24, 25, 26, 28 /
      data cfile_meteor / 'GN93hz.meteor',
     $     'GS98hz.meteor', 'AGS04hz.meteor' /
c
c /c_mixfiles_used_opal_z/ data:
c
      data cfile_opal_used / ' ', ' ', n_totmix * ' ' /
c
c /ext_CNO_opal_z/ data:
c
      data len_def_CNO_ext / 0, 5, 6, 8, 5 /
      data cdef_CNO_ext / ' ', '.CtoN', '.COtoN', '.CNOtoNe', '.user' /
c
c /zinter_opal_z/ data: (note: zavail, iadd_zavail are computed in get_zavail)
c
      data zavail / nzm * 0.0 /, iadd_zavail / nadd_zavail * 0 /
c
      data zvalhi /0.,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.1/
c
      data zval / 0.,0.001,0.004,0.01,0.02,0.03,0.05,0.1 /
c
      data zalval / 0.,0.0001,0.0003,0.001,0.002,0.004,0.01,0.02,
     $     0.03,0.04,0.06,0.08,0.1 /
c
      data (mnofz(i),i=1,mx) / 1, 2, 3, 4, 5 /
c
      data nofz /
     $     8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,
     $     8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,7,7,7,7,7,7,
     $     6,6,6,6,6,6,6,6,6,6,5,
     $     8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,
     $     8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,7,7,7,7,7,7,7,
     $     6,6,6,6,6,6,6,6,6,5,5,
     $     8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,
     $     8,8,8,8,8,8,8,8,8,8,8, 8,8,7,7,7,7,7,7,7,7,7,
     $     6,6,6,6,6,6,6,5,5,5,5,
     $     8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,
     $     8,8,8,8,8,8,8,8,8,8,8, 7,7,7,7,7,7,7,7,7,7,7,
     $     5,5,5,5,5,5,5,5,5,5,4,
     $     8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,
     $     8,8,8,8,8,8,8,8,8,8,7, 7,7,7,7,7,6,6,6,6,6,6,
     $     4,4,4,4,4,4,4,3,3,2,1,
     $     7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,
     $     7,7,7,7,7,7,7,7,7,7,6, 6,6,6,6,6,5,5,5,5,5,5,
     $     0,0,0,0,0,0,0,0,0,0,0,
     $     6,6,6,6,6,6,6,6,6,6,6, 6,6,6,6,6,6,6,6,6,6,6,
     $     6,6,6,6,6,6,6,6,6,6,5, 4,4,3,3,2,1,0,0,0,0,0,
     $     0,0,0,0,0,0,0,0,0,0,0,
     $     0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,
     $     0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,
     $     0,0,0,0,0,0,0,0,0,0,0 /
c
c /czinte_opal_z/ data:
c
      data cxfil / 'Gx00', 'Gx03', 'Gx10', 'Gx35', 'Gx70' /
      data czfil / 'z0  ', 'z001', 'z004', 'z01 ',
     $     'z02 ', 'z03 ', 'z05 ', 'z10 '/
c
c /c_opal_ctrl_smooth/ data:
c
      data init_smo / 2 /, low_CO_smo / 1 /, interp_CO_smo / 1 /
c
c /opdir/ data:
c
      data copdir / ' ' /
c
c /c_ini_ferg/ data:
c
      data z_ferg / 0.0, 0.00001, 0.00003, 0.0001, 0.0003, 0.001,
     $     0.002, 0.004, 0.01, 0.02, 0.03, 0.04, 0.05, 0.06, 0.08,
     $     0.1 /
      data x_ferg / 0.0, 0.1, 0.2, 0.35, 0.5, 0.7, 0.8, 0.9, 0.95,
     $     1.0 /
      data iacc_ferg / 1 /, igot_t_ferg / 0 /, igot_r_ferg / 0 /
      data itype_ferg / 0 /, lsep_ferg / 1 /, lext_ferg / 4 /
      data ltype_ferg / 8, 1, 4, 4, 6, 4, 6,
     $     8, 8, 8, 8, 8, -1 /
      data itype_def_ferg / ntyp1_ferg, 1, 5, 4, 3, 2,
     $     6, 7, 8, 9, 10, 11, 12 /
      data ione_ferg / -1, 0, 0, 0, 1, 1, 1,
     $     1, 1, 1, 1, 1, -1 /
      data lz_ferg / 1,5,5,4,4, 3,3,3,2,2,2, 2,2,2,2,1 /
      data lx_ferg / 1,1,1,2,1, 1,1,1,2,2 /
      data cz_ferg / '0    ', '00001', '00003', '0001 ', '0003 ',
     $     '001  ', '002  ', '004  ', '01   ', '02   ', '03   ',
     $     '04   ', '05   ', '06   ', '08   ', '1    ' /
      data cx_ferg / '0    ', '1    ', '2    ', '35   ', '5    ',
     $     '7    ', '8    ', '9    ', '95   ', '10   ' /
      data ctype_ferg/ 'Alexopac', 'g', 'g98.', 'l03.', 'ags04.',
     $     's92.', 's92ae.', 'gs98-.2.', 'gs98+.2.', 'gs98+.4.',
     $     'gs98+.6.', 'gs98+.8.', ' ' /
      data csub_ferg/ ' ', 'f05_g93', 'f05_gs98', 'f05_l03',
     $     'f05_ags04', 'f05_s92', 'f05_s92ae', 'f05_gs98-.2',
     $     'f05_gs98+.2', 'f05_gs98+.4', 'f05_gs98+.6', 'f05_gs98+.8',
     $     'f05_user' /
      data csep_ferg / '.' /, cext_ferg / 'tron' /
c
c /c_ofe_in_ferg/ data:  Assume that [O/Fe] = 0.3 in the s92ae mix of the
c                        Ferguson et al. 2005 molecular opacities:
c
      data ofein_ferg / 0.3 /, i_ofe_ferg / 7 /, i_ofe0_ferg / 6 /
c
c /c_prev_ferg/ data:
c
      data zlogp_ferg / -9.0 /, xp_ferg / -9.0 /
      data zlp1_ferg / -9.0 /, xp1_ferg / -9.0 /
      data zlp2_ferg / -9.0 /, xp2_ferg / -9.0 /
      data i1p_ferg / -1 /, i4p_ferg / -9 /
      data j1p_ferg / -1 /, j4p_ferg / -9 /
c
c /c_tsw_ferg/ data:    i.e., flt_max_ferg = 4.5 , fltswlo_ferg_def = 4.2 ,
c                                                  fltswhi_ferg_def = 4.4
      data slt_max_ferg / -1.5 /
      data sltswlo_ferg_def / -1.8 /, sltswhi_ferg_def / -1.6 /
      data sltswlo_ferg / -1.8 /, sltswhi_ferg / -1.6 /
      data sltswmid_ferg / -1.7 /, dltsw2inv_ferg / 100. /
c
c /c_ini_alex/ data:
c
      data z_alex / 0.0,0.0001,0.0003,0.001,0.002,
     $     0.004,0.01,0.02,0.03,0.05, 0.1,1.0 /
      data x_alex / 0.0,0.03,0.1,0.35,0.7,0.8 /
      data flt_alex / 3.00,3.05,3.10,3.15,3.20,
     $     3.25,3.30,3.35,3.40,3.45, 3.50,3.55,3.60,3.65,3.70,
     $     3.75,3.80,3.85,3.90,3.95, 4.0,4.05,4.1 /
      data flro_alex / -14.,-13.75, -13.5,-13.25,-13.0,-12.75,-12.5,
     $     -12.25, -12.,-11.75,-11.5,-11.25,-11.,
     $     -10.75,-10.5,-10.25,-10.,-9.75, -9.5,-9.25,-9.,-8.75,-8.5,
     $     -8.25,-8.,-7.75,-7.5,-7.25, -7.,-6.75,-6.5,-6.25,-6. /
c
c /c_filename_alex/ data:
c
      data need_alex_dir / 1 /
      data cfile_alex / ' ' /
c
c /c_got_alex/ data:
c
      data kavail_alex / 0 /, kuse_alex / 1 /, kdo_alex / 0 /
      data iualex / 23 /
c
c /c_trho_sw_alex/ data:
c
      data fltswlo_alex_def / 3.87 /, fltswhi_alex_def / 3.97 /
      data flrhoswlo_alex_def / -6.25 /, flrhoswhi_alex_def / -5.75 /
      data fltswlo_r_alex_def / 3.7 /, fltswhi_r_alex_def / 3.8 /
      data fltswlo_alex / 3.87 /, fltswhi_alex / 3.97 /
      data fltswmid_alex / 3.92 /, dltsw2inv_alex / 400. /
      data sltswhi_alex / -2.03 /, flrhoswlo_alex / -6.25 /
      data flrhoswhi_alex / -5.75 /, flrhoswmid_alex / -6.00 /
      data dlrhosw2inv_alex / 16. /, fltswlo_r_alex / 3.7 /
      data fltswhi_r_alex / 3.8 /, fltswmid_r_alex / 3.75 /
      data dltsw2inv_r_alex / 400. /, sltswlo_alex / -2.13 /
      data isw_rho_alex / 1 /
c
c /c_got_cond/ data:
c
      data kavail_cond / 0 /, kuse_cond / 1 /, kdo_cond / 0 /
      data iucond / 23 /, ifix_h_cond / 1 /, itoh_gap / 1 /
      data itoh_replace / 99 /, ifix_h_cond_next / 1 /
      data itoh_gap_next / 1 /, itoh_replace_max / 99, 0, 2 /
c
c /c_filename_cond/ data:
c
      data need_cond_dir / 1 /
      data cfile_cond / ' ' /
      data cdef_cond / 'Condopac', 'condall06', 'condall06.d' /
c
c /c_kcond_itoh/ data:
c
      data ai_kc / 1.007825,4.002603,12.0,15.994915,21.99138 /
      data ax_kc / .34542,-.28157,.09184,-.03734,
     $     .62199,-.16110,.15574,-.02893, .9896,-.1851,.1019,-.0360,
     $     1.0779,-.1838,.1059,-.0290, 1.1480,-.1779,.1115,-.0233,
     $     .25152,-.10843,-.00596,-.00950, .36090,.02576,.05061,.00015,
     $     .4406,-.0161,-.0093,-.0028, .4486,-.0160,-.0014,.0039,
     $     .4557,-.0096,.0063,.0065,
     $     .1580,-.0607,-.0188,0., .2486,.0564,.0366,0.,
     $     .2510,-.0114,-.0160,0., .2481,-.0066,-.0050,0.,
     $     .2511,0.,0.,0. /
      data bx_kc / -.61919,.40004,-.16585, -.65222,.48601,-.18266,
     $     -.8825,.6675,-.3798, -.9743,.6955,-.3966,
     $     -1.0553,.7336,-.4147,
     $     -.36667,.14040,-.04588, -.40559,.15316,-.04058,
     $     -.4821,.0826,-.0557, -.5193,.0822,-.0467,
     $     -.5463,.0848,-.0395,
     $     -.2698,.0537,-.0059, -.2948,.0456,-.0026,
     $     .3964,-.0080,-.0193, -.4094,-.0015,-.0047,
     $     -.1030,0.,0. /
      data cx_kc/
     $     .35742,-.41151,.21552, .36580,-.52176,.26240,
     $     -.0915,-1.5848,1.1882, -.1040,-1.7692,1.3546,
     $     -.0548,-2.0486,1.550,
     $     .10493,-.09537,.04682, .12140,-.11621,.04939,
     $     -.5193,-.0830,.0147, -.5403,-.1022,.0416,
     $     -.5448,-.1146,.0664,
     $     0.,0.,0., 0.,0.,0.,
     $     0.,0.,0., 0.,0.,0.,
     $     0.,0.,0./
c
c /d_opal_z/ data:
c
      data dkap / 0.0 /
c
c /c_level_err_opal_z/ data:
c
      data level_err / 1 /
c
c /c_level_list_opal_z/ data:
c
      data iu_list / 6 /, level_list / 0 /, list_mult / 0 /
      data list_gn / n_zmixes * 0, 0, n_totmix * 0 /
c
c /c_ctab/ data:
c
      data ctab / '	' /
c
c /chkpoc/ data:
c
c-vms[                                                !  For VMS:
c-vms;      data cb / ':', ']', ';', ';', ';', ';' /
c-vms]
c-sun-iris-linux[                                     ! For UNIX:
      data cb / '/', '/', '_', '~', '+', '-' /
c-sun-iris-linux]
c
      end
c
c******************************************************************************
c
      subroutine opalinit( khighz, ofebrack, z, kz, kmet )
c     ====================================================
c
c  INITIALIZATIONS AND OPACITY FILE SETUP:
c
c  This subroutine performs some initializations that would otherwise be done
c  at the beginning of subroutine READZEXCO.  These do some grid set-up, look
c  for the user-supplied non-zero [O/Fe] file if khighz = 5 or -5, calculate
c  [O/Fe] values for each of the possible mixes, and find the OPAL-opacity-file
c  directory name.
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( nrdel=nrb-1, ntdel=ntb-1 )
c
c PARAMETERS:
c  zdel = 0.001 = offset for Z, Z+C, and Z+O, to make log interpolation behave
c                  reasonably at small Z values: Z-interpolation is performed
c                  using log(Z+zdel), while the CO-interpolation is performed
c                  using log(C+Z+zdel) and log(O+Z+zdel)
c  xdel = 0.03 = usual (high-T) offset for X, to make log interpolation behave
c                 reasonably at small X; note that 0.03 works better than 0.005
c  xdelmin = 0.001 = lowest value of X offset ever used (at low temperatures)
c
      parameter ( zdel=0.001, xdel=0.03, xdelmin=0.001 )
c
c PARAMETERS: value used for "bad" (missing) logKappa values:
c
      parameter ( badlogkval=1.e+35, badlogklim=20. )
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mx_hi_nz=mx_hi*nz )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      common/e_opal_z/ opact,dopact,dopacr,dopactd,fedge,ftredge,fzedge
      save /e_opal_z/
c
      common /x_opal_z/ z_opal, x_opal, xc_opal, xo_opal, slt_opal,
     $     slr_opal, fcn_opal, fcon_opal, fcnone_opal, fu_opal
      save /x_opal_z/
c
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c
      common /alt_change_opal_z/ main_alt_change, iulow, khighz_in,
     $     ofebrack_in
      save /alt_change_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
c-implicit;      real*4 xiz_mix,fninz_mix,bracketife_mix,bracketofe_opalmixes,
c-implicit;     $     xofe_opalmixes,xiz_opalmixes,fninz_opalmixes
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c
c-implicit;      real*4 bracketofe_opalGS98, xofe_opalGS98, xiz_opalGS98,
c-implicit;     $     fninz_opalGS98, atwt_opalGS98
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      parameter ( n_mix_meteor = 3 )
      double precision xiz_meteor, fninz_meteor
      character*255 cfile_meteor(n_mix_meteor)
      common /c_meteor_mix_opal_z/ xiz_meteor(nel_zmix,n_mix_meteor),
     $     fninz_meteor(nel_zmix,n_mix_meteor),
     $     nuc_charge_opalmixes(nel_zmix), cfile_meteor
      save /c_meteor_mix_opal_z/
c
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c
      character*80 cdef_CNO_ext(n_cnobeg:n_totmix)
      common /ext_CNO_opal_z/ len_def_CNO_ext(n_cnobeg:n_totmix),
     $     cdef_CNO_ext
      save /ext_CNO_opal_z/
c
      parameter ( mz=8, mz_m1=mz-1, mz_m2=mz-2, mzhi=11, mzal=13,
     $     nzm=mzal+1, nadd_zavail=nzm-mz )
c
      common/zinter_opal_z/ zvalhi(mzhi),nofz(mzhi,5,mo),mnofz(mx),
     $     zval(mz),zalval(mzal),zavail(nzm),iadd_zavail(nadd_zavail)
      save /zinter_opal_z/
c
      character*4 cxfil(5),czfil(mz)
      common/czinte_opal_z/ cxfil,czfil
      save /czinte_opal_z/
c
      common/c_opal_ctrl_smooth/ init_smo, low_CO_smo, interp_CO_smo
      save /c_opal_ctrl_smooth/
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c___
      logical lxst
c
c COMMON /outdeb/ : controls the extent of error and debugging output, if the
c                    debug statements are un-commented by removing "c-debug;"
c                    at the beginning of the relevant lines 
c   if a log10(opacity) value is > oudebl, then the relevant debug output is
c                    performed (provided that it is not commented out)
c   else if ioudeb > 5 , then all debug output controlled by ioudeb is always
c                    performed (provided that it has not been commented out),
c                    i.e., initial-call, CO-, Z-, R-, T-, and X-interp output
c   else if ioudeb > 4 , then initial-call, Z-, R-, T-, and X-interp output
c   else if ioudeb > 3 , then initial-call, R-, T-, and X-interp output
c   else if ioudeb > 2 , then initial-call, T-, and X-interp output
c   else if ioudeb > 1 , then initial-call and X-interp output
c   else if ioudeb > 0 , then initial-call output is performed
c   koudeb counts how many debug outputs have been performed (e.g., so that
c           you can set ioudeb = -1 or increase oudebl after a given number
c           of debug outputs have been performed)
c-debug[
c-debug;      common/outdeb/ ioudeb,oudebl,koudeb
c-debug]
c
c===
c					! These initializations only done once:
      if ( itimeco .ne. 12345678 ) then
c							! check some parameters
         if ( nrm .ne. 19 .or. ntm .ne. 70 ) stop
     $        ' STOP -- OPAL CONST ERROR: NRM .ne. 19 or NTM .ne. 70 '
         if ( nrb .le. 0 .or. nrb .gt. 12 ) stop
     $        ' STOP -- OPAL CONST ERROR: NRB < 1 or NRB > 12 '
         if ( nr .lt. 6 ) stop
     $        ' STOP -- OPAL CONST ERROR: Too few R values: NR < 6 '
         if ( nre .gt. nrm ) stop
     $        ' STOP -- OPAL CONST ERROR: NRE > NTM '
         if ( mc .ne. mo .or. mc .ne. 8 ) stop
     $        ' STOP -- OPAL CONST ERROR: MC .ne. MO or MC .ne. 8 '
         if ( nt .lt. 8 .or. ntb .le. 0 ) stop
     $        ' STOP -- OPAL CONST ERROR: NT < 8 or NTB < 1 '
         if ( ntb .gt. nta(nre) - 3 ) stop
     $        ' STOP -- OPAL CONST ERROR: NTB > NTA(NRE) - 3 '
         if ( mx .le. 0 .or. mx .gt. 5 ) stop
     $        ' STOP -- OPAL CONST ERROR: MX < 1 or MX > 5 '
         if ( nz .le. 0 .or. nz .gt. nzm ) stop
     $        ' STOP -- OPAL CONST ERROR: NZ < 1 or NZ > 14 '
c						   ! initialize T,R values
         if ( init_trvals .le. 0 ) call get_trvals
c
c			  ! get combined Z-tabulation values available in files
         call get_zavail
c					  ! get log10( X_GH93hz + xdel ) values
         do ix = 1, mx_hi
            xxx_cno(ix) = log10( xhi_in(ix) + xdel )
            xxx_hi(ix) = xxx_cno(ix)
         enddo
         xxx_hi(1) = log10( 0.03 + xdel )
c
c				! have now done once-only initializations
         itimeco = 12345678
c			     ! end of initializations that are done only once
      endif
c				   ! initialize "files that were actually used"
      cfile_opal_used(-1) = copdir
      cfile_opal_used(0) = ' '
      cfile_opal_used(1) = ' '
      do i = 4, n_totmix
         cfile_opal_used(i) = ' '
      enddo
c		   ! obtain the directory specification for the Gz???.x?? files
c
      kope = lnblnk(copdir)
c					 ! check for error in directory name
      if ( kope .gt. 0 ) then
c
         if ( copdir(kope:kope) .ne. cb(1) .and.
     $        copdir(kope:kope) .ne. cb(2) ) then
            write(6,5) cb(1), cb(2), copdir(:kope)
 5          format(' OPAL Error: directory name does not end in "',a1,
     $           '" or "',a1,'":'/' ',a)
            stop ' STOP -- OPAL Error: directory name bad last char. '
         endif
c
      endif
c
      if ( kope .gt. 246 ) then
         write(6,10) copdir(:kope)
 10      format(' OPAL Error: directory name > 246 characters:'/
     $        ' ',a)
         stop ' STOP -- OPAL Error: directory name > 246 characters'
      endif
c
c  NOTE that some systems return FALSE for the existence of a directory, so
c  one cannot check for the directory's existence.
c
c-dir;      if ( kope .gt. 0 ) then
c-dir;         call inqfil( copdir, lxst )
c-dir;         if ( .not. lxst ) then
c-dir;            write(6,20) copdir(:kope)
c-dir; 20         format(' STOP -- READCO: OPAL directory does not exist:'/
c-dir;     $           ' ',a)
c-dir;            stop
c-dir;         endif
c-dir;      endif
c		    ! just in case mx = 1 (i.e., if there is only one X-value)
      dfsx(2) = 1.
c
      itime = 0
      igznotgx = 0
      mxzero = 0
      mx03 = 0
c		     ! indices of X=0 and X=.03 mixes, and X-part of file names
      do i = 1, mx
c					! loop over X-index (i, not m, here!)
         if ( xa(i) .eq. 0.0 ) then
            mxzero = i
            cxfil(i) = 'Gx00'
            mnofz(i) = 1
         else if ( abs(xa(i)-0.03) .lt. small_1m6 ) then
            xa(i) = 0.03
            mx03 = i
            cxfil(i) = 'Gx03'
            mnofz(i) = 2
         else if ( abs(xa(i)-0.1) .lt. small_1m6 ) then
            xa(i) = 0.1
            cxfil(i) = 'Gx10'
            mnofz(i) = 3
         else if ( abs(xa(i)-0.35) .lt. small_1m6 ) then
            xa(i) = 0.35
            cxfil(i) = 'Gx35'
            mnofz(i) = 4
         else if ( abs(xa(i)-0.7) .lt. small_1m6 ) then
            xa(i) = 0.7
            cxfil(i) = 'Gx70'
            mnofz(i) = 5
         else
            stop ' STOP -- OPAL Error: bad X value in array  xa(mx) '
         endif
c					! initialize xx, for X-interpolations
         xx(i) = log10(xdel+xa(i))
         if ( i .ge. 2 ) then
            dfsx(i) = 1./(xx(i)-xx(i-1))
            if ( dfsx(i) .le. 0. ) stop
     $           ' STOP -- OPAL Error: bad X order in array  xa(mx) '
         endif
c			! have not yet read any opacities for this Z-value:
c
         if ( kz .gt. 0 .and. kz .le. nz ) then
            do mq = 1, nr
               do il = 1, nt
                  do k = 1, mo
                     do j = 1, mc
                        co(i,j,k,il,mq,kz) = badlogkval
                     enddo
                  enddo
               enddo
            enddo
         endif
c		! end of X-loop
      enddo
c
      dfsx(1) = dfsx(2)
c						! set khizat, as in READEXCO
      kzbelo = mz
      do while( kzbelo .gt. 1 .and. z .le. zval(kzbelo) - small_1m6 )
         kzbelo = kzbelo-1
      enddo
c
      if ( z .eq. 0. ) then
         khizat = 0
         klozat = 0
      else if ( khighz .lt. 0 ) then
         khizat = 1
         if ( ofebrack .eq. 0. ) then
            klozat = 1
         else
            klozat = min( mod( abs(khighz), 10 ) , n_zmixes )
         endif
      else
         klozat = 0
         khizat = min( mod( khighz, 10 ) , n_zmixes )
         if ( ofebrack .eq. 0. ) khizat = min(khizat,1)
         if ( khizat .eq. 1 .and.
     $        ( ( z .ge. 0.01 .and. z .le. 0.02 ) .or.
     $        ( abs(zval(kzbelo)-z) .le. small_1m6 .and.
     $        z .ge. 1.e-5 ) ) ) khizat = 0
      endif
c				! check length of GS98 filenames to be used
      if ( klozat .gt. 0 ) then
         do k = 1, klozat, max( klozat - 1 , 1 )
            if ( kope + lnblnk( cfile_opalGS98(k) ) .gt. 255 ) stop
     $           ' STOP -- READCO: alt-main-file name too long. '
         enddo
      endif
c					! should use the input [O/Fe] filename?
      if ( khizat .ge. n_zmixes ) then
c								! it exists?
         if ( cfile_opalmixes(n_zmixes) .eq. '        ' ) stop
     $        ' STOP -- READCO: no user-specified [O/Fe]-file. '
c
c			 ! obtain mix specifications for the input [O/Fe] file
         igetzxi = 9
         i_rewind = 0
         itab_dum = 0
         line = 0
c						     ! use copdir temporarily
         copdir(kope+1:) = cfile_opalmixes(n_zmixes)
         cfile_opal_used(n_zmixes) = cfile_opalmixes(n_zmixes)
         call open_chk_zip( iulow, copdir, i_gzip,
     $        'READCO Error: user-specified [O/Fe]-file not found.' )
         ifound = mixfind(iulow,n_zmixes,igetzxi,i_rewind,itab_dum,
     $        line,0.0,0.0,0.0,0.0)
         if ( ifound .eq. 0 ) stop
     $        ' STOP -- READCO: bad user-specified [O/Fe]-file. '
         call close_chk_zip( iulow, copdir, i_gzip )
c
c					  ! remove filename from directory name
         copdir(kope+1:) = ' '
c					   ! or use GS98 input [O/Fe] filename?
      else if ( klozat .ge. n_zmixes ) then
c
         call chk_ofe_alt_file( n_zmixes )
c								! it exists?
         if ( cfile_opal_used(n_zmixes) .eq. ' ' ) stop
     $        ' STOP -- READCO: no user alt-[O/Fe]-file. '
c								      ! length?
         if ( kope + lnblnk( cfile_opal_used(n_zmixes) ) .gt. 255 )
     $        stop
     $        ' STOP -- READCO: user alt-[O/Fe]-file name too long. '
c
c			 ! obtain mix specifications for the input [O/Fe] file
         igetzxi = 9
         i_rewind = 0
         itab_dum = 0
         line = 0
c						       ! use copdir temporarily
         copdir(kope+1:) = cfile_opal_used(n_zmixes)
         call open_chk_zip( iulow, copdir, i_gzip,
     $        'READCO Error: user alt-[O/Fe]-file not found.' )
         ifound = mixfind(iulow,-n_zmixes,igetzxi,i_rewind,itab_dum,
     $        line,0.0,0.0,0.0,0.0)
         if ( ifound .eq. 0 ) stop
     $        ' STOP -- READCO: bad user-specified alt-[O/Fe]-file. '
         call close_chk_zip( iulow, copdir, i_gzip )
c
c					  ! remove filename from directory name
         copdir(kope+1:) = ' '
c
      endif
c							     ! changed 'GS98hz'
      if ( khighz .lt. 0 .and. main_alt_change .gt. 0 ) then
c								! it exists?
         if ( cfile_opalGS98(1) .eq. ' ' ) stop
     $        ' STOP -- READCO: no main alternate [O/Fe]=0.0 file. '
c								      ! length?
         if ( kope + lnblnk( cfile_opalGS98(1) ) .gt. 255 ) stop
     $        ' STOP -- READCO: alternate [O/Fe]=0.0 name too long. '
c
c			 ! obtain mix specifications for input [O/Fe]=0 file
         igetzxi = 9
         i_rewind = 0
         itab_dum = 0
         line = 0
c						       ! use copdir temporarily
         copdir(kope+1:) = cfile_opalGS98(1)
         cfile_opal_used(1) = cfile_opalGS98(1)
         call open_chk_zip( iulow, copdir, i_gzip,
     $        'READCO Error: alternate [O/Fe]=0.0 file not found.' )
         ifound = mixfind(iulow,-1,igetzxi,i_rewind,itab_dum,
     $        line,0.0,0.0,0.0,0.0)
         if ( ifound .eq. 0 ) stop
     $        ' STOP -- READCO: bad alternate [O/Fe]=0.0 file. '
         call close_chk_zip( iulow, copdir, i_gzip )
c							! have read it now
         main_alt_change = main_alt_change - 2
c
c					  ! remove filename from directory name
         copdir(kope+1:) = ' '
c
      endif
c				! get mix Z-composition specifications (these
c				! will be recomputed for any mix read in later)
      do i = 1, n_zmixes
         xofe_opalGS98(i) = fninz_opalGS98(kel_o,i)
     $        / max( fninz_opalGS98(kel_fe,i) , 1.e-36 )
         bracketofe_opalGS98(i) = log10( xofe_opalGS98(i)
     $        / xofe_opalGS98(1) )
         xofe_opalmixes(i) = fninz_opalmixes(kel_o,i)
     $        / max( fninz_opalmixes(kel_fe,i) , 1.e-36 )
         bracketofe_opalmixes(i) = log10( xofe_opalmixes(i)
     $        / xofe_opalmixes(1) )
      enddo
c			       ! Reset current-mix data.  If GS98 [O/Fe] shift:
      if ( klozat .gt. 1 ) then
c				! get interpolation factors fofe (for GS98hz) &
c						  ! omfofe=1-fofe (other file)
         xofe = 10.**ofebrack * xofe_opalGS98(1)
         fofe = ( fninz_opalGS98(kel_o,klozat)
     $        - xofe * fninz_opalGS98(kel_fe,klozat) )
     $        / ( ( fninz_opalGS98(kel_fe,1)
     $        - fninz_opalGS98(kel_fe,klozat) ) * xofe
     $        + fninz_opalGS98(kel_o,klozat)
     $        - fninz_opalGS98(kel_o,1) )
         omfofe = 1. - fofe
c					! get Z-composition of interpolated mix
         sum_niai = 0.0
         do i = 1, nel_zmix
            fninz_mix(i) = fofe * fninz_opalGS98(i,1)
     $           + omfofe * fninz_opalGS98(i,klozat)
            xiz_mix(i) = fninz_mix(i) * atwt_opalGS98(i)
            sum_niai = sum_niai + xiz_mix(i)
         enddo
         do i = 1, nel_zmix
            xiz_mix(i) = xiz_mix(i) / sum_niai
            bracketife_mix(i) = log10( ( max( fninz_mix(i) , 1.e-36 )
     $           * fninz_opalGS98(kel_fe,1) )
     $           / ( max( fninz_mix(kel_fe) , 1.e-36 )
     $           * fninz_opalGS98(i,1) ) )
         enddo
c				      ! Else, if use GS98 but no [O/Fe] shift:
      else if ( khighz .lt. 0 ) then
c
         do i = 1,nel_zmix
            xiz_mix(i) = xiz_opalGS98(i,1)
            fninz_mix(i) = fninz_opalGS98(i,1)
            bracketife_mix(i) = 0.
         enddo
c				      ! Else, if there is no GN93 [O/Fe] shift:
      else if ( khizat .le. 1 ) then
c
         do i = 1,nel_zmix
            xiz_mix(i) = xiz_opalmixes(i,1)
            fninz_mix(i) = fninz_opalmixes(i,1)
            bracketife_mix(i) = 0.
         enddo
c		  ! Else, if there is the [O/Fe] shift (also done in READEXCO):
      else
c		! get interpolation factors fofe (for GN93hz) and omfofe=1-fofe
c
         xofe = 10.**ofebrack * xofe_opalmixes(1)
         fofe = ( fninz_opalmixes(kel_o,khizat)
     $        - xofe * fninz_opalmixes(kel_fe,khizat) )
     $        / ( ( fninz_opalmixes(kel_fe,1)
     $        - fninz_opalmixes(kel_fe,khizat) ) * xofe
     $        + fninz_opalmixes(kel_o,khizat)
     $        - fninz_opalmixes(kel_o,1) )
         omfofe = 1. - fofe
c					! get Z-composition of interpolated mix
         sum_niai = 0.0
         do i = 1, nel_zmix
            fninz_mix(i) = fofe * fninz_opalmixes(i,1)
     $           + omfofe * fninz_opalmixes(i,khizat)
            xiz_mix(i) = fninz_mix(i) * atwt_opalGS98(i)
            sum_niai = sum_niai + xiz_mix(i)
         enddo
         do i = 1, nel_zmix
            xiz_mix(i) = xiz_mix(i) / sum_niai
            bracketife_mix(i) = log10( ( max( fninz_mix(i) , 1.e-36 )
     $           * fninz_opalmixes(kel_fe,1) )
     $           / ( max( fninz_mix(kel_fe) , 1.e-36 )
     $           * fninz_opalmixes(i,1) ) )
         enddo
      endif
c
      imet = iabs( kmet )
      if ( imet .gt. n_mix_meteor ) imet = 0
c
      if ( imet .eq. 0 .and. cfile_opalGS98(0) .eq. ' ' ) then
         if ( khighz .ge. 0 ) then
            if ( cfile_meteor(1)(1:4) .eq. cfile_opalmixes(1)(1:4) )
     $           imet = 1
         else
            do i = 1, n_mix_meteor
               j = ( i / 3 ) + 4
               if ( cfile_meteor(i)(1:j) .eq. cfile_opalGS98(1)(1:j) )
     $              imet = i
            enddo
         endif
      endif
c				! initialize meteoritic mix
      if ( imet .eq. 0 ) then
c
         if ( cfile_opalGS98(0) .eq. ' ' ) then
            if ( khighz .gt. 0 ) then
               cfile_opalGS98(0) = cfile_opalmixes(1)
            else
               cfile_opalGS98(0) = cfile_opalGS98(1)
               if ( cfile_opalGS98(0) .eq. ' ' )
     $              cfile_opalGS98(0) = cfile_opalmixes(1)
            endif
            i = lnblnk( cfile_opalGS98(0) )
            cfile_opalGS98(0)(i+1:) = '.meteor'
         endif
c						     ! use copdir temporarily
         copdir(kope+1:) = cfile_opalGS98(0)
c
         call inqfil( copdir, lxst )
         if ( .not. lxst ) then
            i = lnblnk( copdir )
            copdir(i+1:) = '.gz'
            call inqfil( copdir, lxst )
            if ( .not. lxst ) then
               copdir(i+1:) = '.Z '
               call inqfil( copdir, lxst )
            endif
            copdir(i+1:) = '   '
         endif
c
         if ( .not. lxst ) then
c
            imet = n_mix_meteor
c
         else
c				! obtain meteoritic mix from file
            igetzxi = 8
            i_rewind = 0
            itab_dum = 0
            line = 0
            call open_chk_zip( -iulow, copdir, i_gzip,
     $           'Meteoritic-file not found; use AGS04 meteor-mix.' )
            if ( i_gzip .le. -99999 ) then
               imet = n_mix_meteor
            else
c-dont;               if ( list_gn(0) .gt. 0 ) then
c-dont;                  if ( iu_list .eq. iulow ) then
c-dont;                     write(6,4) iu_list
c-dont; 4                   format(/' ***OPAL WARNING: READCO:',
c-dont;     $                    ' bad LIST_IU =',i3,
c-dont;     $                    ', reset to 6 (standard output)'/)
c-dont;                     iu_list = 6
c-dont;                  endif
c-dont;                  write(iu_list,1) copdir(:lnblnk(copdir))
c-dont; 1                format(' ***OPAL/Type_1 (ONLY read X_meteor): ',a)
c-dont;                  list_gn(0) = 0
c-dont;               endif
               cfile_opal_used(0) = cfile_opalGS98(0)
               ifound = mixfind(iulow,0,igetzxi,i_rewind,itab_dum,
     $              line,0.0,0.0,0.0,0.0)
               if ( ifound .eq. 0 ) imet = n_mix_meteor
               call close_chk_zip( iulow, copdir, i_gzip )
            endif
c
         endif
c					  ! remove filename from directory name
         copdir(kope+1:) = ' '
c
      endif
c
      if ( imet .gt. 0 ) then
c
         cfile_opalGS98(0) = cfile_meteor(imet)
         cfile_opal_used(0) = cfile_opalGS98(0)
c
         do i = 1, nel_zmix
            fninz_opalGS98(i,0) = fninz_meteor(i,imet)
            xiz_opalGS98(i,0) = xiz_meteor(i,imet)
         enddo
c
         xofe_opalGS98(0) = fninz_opalGS98(kel_o,0)
     $        / max( fninz_opalGS98(kel_fe,0) , 1.e-36 )
c
      endif
c
      bracketofe_opalGS98(0) = log10( max( 1.e-36 ,
     $     xofe_opalGS98(0) * fninz_mix(kel_fe)
     $     / max( 1.e-36 , fninz_mix(kel_o) )  ) )
c						   ! end of initializations
      return
      end
c
c******************************************************************************
c
      subroutine get_zavail
c     =====================
c
c  Obtain combined Z-tabulation values available in the files, and best order
c  in which to enhance the 'Gz???.x??' metallicity table.
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( zdel=0.001, xdel=0.03, xdelmin=0.001 )
c
      parameter ( mz=8, mz_m1=mz-1, mz_m2=mz-2, mzhi=11, mzal=13,
     $     nzm=mzal+1, nadd_zavail=nzm-mz )
c
      common/zinter_opal_z/ zvalhi(mzhi),nofz(mzhi,5,mo),mnofz(mx),
     $     zval(mz),zalval(mzal),zavail(nzm),iadd_zavail(nadd_zavail)
      save /zinter_opal_z/
c
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c___
      dimension z_l(nzm), idz(nzm)
c===					   ! (if it has not already been done):
      if ( iadd_zavail(1) .eq. 0 ) then
c
c  Get the combined Z-array zavail() by combining zval() and zalval(); this
c  should be the same as just adding the value Z=0.05 to the array zalval():
c
         k_l = 1
         k_h = 1
         k_o = 0
         k_a = 0
c
         do while ( k_l .le. mz .or. k_h .le. mzal )
c
            k_a = k_a + 1
            if ( k_a .gt. nzm ) stop
     $           ' STOP -- READCO: combined files have > 14 Z-values. '
            if ( k_l .gt. mz ) then
               zavail(k_a) = zalval(k_h)
            else if ( k_h .gt. mzal ) then
               zavail(k_a) = zval(k_l)
            else
               zavail(k_a) = min( zval(k_l) , zalval(k_h) )
            endif
            z_l(k_a) = log10( zavail(k_a) + zdel )
            idz(k_a) = 0
            if ( k_l .le. mz ) then
               if ( zval(k_l) .lt. zavail(k_a) + small_1m6 ) then
                  idz(k_a) = k_a - k_o
                  k_o = k_a
                  k_l = k_l + 1
               endif
            endif
            if ( k_h .le. mzal ) then
               if ( zalval(k_h) .lt. zavail(k_a) + small_1m6 )
     $              k_h = k_h + 1
            endif
c
         enddo
c
         if ( k_a .lt. nzm ) stop
     $        ' STOP -- READCO: combined files have < 14 Z-values. '
c
c  Get the best order to add values from zavail() to those of zval(), in order
c  to minimize the size of the largest interval at each step; this should
c  result in array values in iadd_zavail() of 5, 3, 13, 10, 12, 2:
c
         k_a = 0
c
         do while ( k_a .lt. nadd_zavail )
c								! next step:
            k_a = k_a + 1
c				! handle special cases where Z-range endpoints
c					! differ (this should never occur!!!):
            if ( idz(1) .eq. 0 ) then
c					! extend range to low Z, if necessary
               iadd_zavail(k_a) = 1
               k_h = 2
               do while ( k_h .lt. nzm .and. idz(k_h) .eq. 0 )
                  k_h = k_h + 1
               enddo
               if ( idz(k_h) .eq. 0 )
     $              stop ' STOP -- READCO: mz = 0 cannot happen. '
               idz(k_h) = k_h - 1
               idz(1) = 1
c
            else if ( idz(nzm) .eq. 0 ) then
c					     ! or extend to high Z if necessary
               iadd_zavail(k_a) = nzm
               k_h = nzm - 1
               do while ( k_h .gt. 1 .and. idz(k_h) .eq. 0 )
                  k_h = k_h - 1
               enddo
               if ( idz(k_h) .eq. 0 )
     $              stop ' STOP -- READCO: this REALLY cannot happen. '
               idz(nzm) = nzm - k_h
c
            else
c		      ! GENERALLY: find largest remaining subdividable interval
               k_h = 0
               dz_max = 0.
               do i = 2, nzm
                  if ( idz(i) .gt. 1 ) then
                     d_z = z_l(i) - z_l(i-idz(i))
                     if ( d_z .gt. dz_max ) then
                        dz_max = d_z
                        k_h = i
                     endif
                  endif
               enddo
               if ( k_h .eq. 0 )
     $              stop ' STOP -- READCO: k_h = 0 cannot happen. '
c
c					   ! find best subdivision of interval
               if ( idz(k_h) .eq. 2 ) then
                  k_l = k_h - 2
                  k_o = k_h - 1
               else
                  k_l = k_h - idz(k_h)
                  dz_max = 0.
                  k_o = 0
                  do i = k_l + 1, k_h - 1
                     d_z = ( z_l(k_h) - z_l(i) )
     $                    / ( z_l(i) - z_l(k_l) )
                     if ( d_z .gt. 1. ) d_z = 1. / d_z
                     if ( d_z .gt. dz_max ) then
                        dz_max = d_z
                        k_o = i
                     endif
                  enddo
                  if ( k_o .eq. 0 )
     $                 stop ' STOP -- READCO: k_o = 0 cannot happen. '
               endif
c						! store this subdivision
               iadd_zavail(k_a) = k_o
               idz(k_o) = k_o - k_l
               idz(k_h) = k_h - k_o
c
            endif
c
         enddo
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine get_trvals
c     =====================
c
      parameter ( small_1m6=1.e-6, small_5m6=5.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( nrdel=nrb-1, ntdel=ntb-1 )
c
c PARAMETERS: positions of DlogT-change in table, low logT and logR values:
c
      parameter ( ks81=ntm-3, ks83=ks81+1, ks60=ks81-21, ks61=ks60+1,
     $     alrlo=-8.0, flogtlo=3.75, flogt60=6.0, flogt81=8.1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
c COMMON /b_opal_z/ : high and low logT6 and logR limits, and mix Z-values:
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
c COMMON /alink_opal_z/ : contains data needed for smoothing routine OPALTAB
c
      common/alink_opal_z/ NTEMP,NSM,nrlow,nrhigh,RLE,t6arr(100),
     $     coff(100,nrm)
      save /alink_opal_z/
c===					! only initialize once
      if ( init_trvals .gt. 0 ) return
c
      init_trvals = 1
c				! intialize logR and 1/delta(logR) values
      do i = 1,nrm
         alrf(i) = (i-1)*0.5+alrlo
      enddo
      do i = 1,nr
         alr(i) = alrf(i+nrdel)
         dfsr(i) = 2.
      enddo
c				! intialize logT, logT6, T6, and 1/delta(logT6)
      flogtin(1) = flogtlo
      do i = 2,ks60
         flogtin(i) = (i-1)*0.05+flogtlo
         if ( i .ge. ntb ) dfs(i-ntdel) = 20.
      enddo
      if ( abs(flogtin(ks60)-flogt60) .gt. small_5m6 ) stop
     $     ' STOP -- READCO: initialization error. '
      flogtin(ks60) = flogt60
      do i = ks61,ks81
         flogtin(i) = (i-ks60)*0.1+flogt60
         if ( i .ge. ntb ) dfs(i-ntdel) = 10.
      enddo
      if ( abs(flogtin(ks81)-flogt81) .gt. small_5m6 ) stop
     $     ' STOP -- READCO: initialization error. '
      flogtin(ks81) = flogt81
      do i = ks83,ntm
         flogtin(i) = (i-ks81)*0.2+flogt81
         if ( i .ge. ntb ) dfs(i-ntdel) = 5.
      enddo
      do i=1,ntm
         t6arr(i) = 10.**(flogtin(i)-6.0)
      enddo
      do i=1,nt
         alt(i) = flogtin(i+ntdel)-6.0
         t6list(i) = t6arr(i+ntdel)
      enddo
c
c-done-above;      do i = 2,nt
c-done-above;         dfs(i) = 1./(alt(i)-alt(i-1))
c-done-above;      enddo
c-done-above;      do i = 2,nr
c-done-above;         dfsr(i) = 1./(alr(i)-alr(i-1))
c-done-above;      enddo
c					  ! For extrapolation at low R and T6
      dfsr(1) = dfsr(2)
      dfs(1) = dfs(2)
c						       ! R-extrapolation limits
      slrlo = alr(1)
      slrhi = alr(nr)
c				     ! make 1-grid-pt extrap just within limits
      dlrlo_inv = dfsr(1) * 0.999999
      dlrhi_inv = dfsr(nr) * 0.999999
c						       ! T-extrapolation limits
      sltlo = alt(1)
      slthi = alt(nt)
c				     ! make 1-grid-pt extrap just within limits
      dltlo_inv = dfs(1) * 0.999999
      dlthi_inv = dfs(nt) * 0.999999
c
      return
      end
c
c******************************************************************************
c
      subroutine opac(z,xh,exC,exO,t6,r)
c     ==================================
c
c.....This is just an alternate interface to OPAL_F_CNOU below, which it calls
c     after taking the log of T6 and R and setting "NO CNO/user interpolation";
c        temperature-input  T6 = temperature in millions of degrees kelvin
c        density-parameter-input  R = density(g/cm**3) / T6**3
c===
      if ( t6 .le. 0. .or. r .le. 0. ) then
         write(6,8437) t6,r
 8437    format(' '/' STOP -- OPAC: non-positive value of T6=',
     $        1p,e11.3,' or R=',e11.3)
         stop
      endif
c
      slt = log10(t6)
      slr = log10(r)
c
      call opal_f_cnou(z,xh,exC,exO,slt,slr,0.0,0.0,0.0,0.0)
c
      return
      end
c
c******************************************************************************
c
      subroutine opal(z,xh,exC,exO,slt,slr)
c     =====================================
c
c.....This is just an alternate interface to OPAL_F_CNOU below, which it calls
c     after setting "NO CNO/user interpolation":
c===
      call opal_f_cnou(z,xh,exC,exO,slt,slr,0.0,0.0,0.0,0.0)
c
      return
      end
c
c******************************************************************************
c
      subroutine opal_x_cno_fu(xh,slt,slr,xmet,nmet,fu)
c     =================================================
c
c.....This is an alternate interface to OPAL_F_XCON_CNOU below
c
      dimension xmet(nmet)
c===
c
c  Get the CNO-interpolation factors, the metallicity Z, and the excess C,O:
c
      call z_fcno(xh,xmet,nmet,fu,z,exC,exO,y,xCN,xON,xNeHeavy,fmuainv,
     $            fmueinv,zsqbar,fcn,fcon,fcnone,fuse)
c
c  Get the opacities by calling OPAL_F_XCON_CNOU:
c
      call opal_f_xcon_cnou(z,xh,exC,exO,y,xCN,xON,xNeHeavy,fmuainv,
     $                     fmueinv,zsqbar,slt,slr,fcn,fcon,fcnone,fuse)
c
      return
      end
c
c******************************************************************************
c
      subroutine opal_f_cnou(z,xh,exC,exO,slt,slr,fcn,fcon,fcnone,fu)
c     ===============================================================
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
c /opalmixes/: --> data{ALL BUT xofe_opalmixes}
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
c  Get approximate values for composition input to conductive opacities
c
      y = max( 0.0 , 1.0 - xh - z - exC - exO )
      xcn = ( xiz_mix(1) + 0.5 * xiz_mix(2) ) * z + exC
      xon = ( xiz_mix(3) + 0.5 * xiz_mix(2) ) * z + exO
      xneheavy = 1. - xh - y - xcn - xon
      if ( xneheavy .lt. 0. ) then
         xon = xon + xneheavy
         xneheavy = 0.
      endif
      if ( xcn .lt. 0. ) then
         xon = xon + xcn
         xcn = 0.
      endif
      if ( xon .lt. 0. ) then
         xcn = xcn + xon
         xon = 0.
         if ( xcn .lt. 0. ) then
            xneheavy = xneheavy + xcn
            xcn = 0.
         endif
      endif
c
c  Get the opacities by calling OPAL_F_XCON_CNOU:
c
      call opal_f_xcon_cnou(z,xh,exC,exO,y,xcn,xon,xneheavy,
     $                      -1.,-1.,-1.,slt,slr,fcn,fcon,fcnone,fu)
c
      return
      end
c
c******************************************************************************
c
      subroutine opal_f_xcon_cnou(z,xh,exC,exO,y,xCN,xON,xNeHeavy,
     $               fmuainv,fmueinv,zsqbar,slt,slr,fcn,fcon,fcnone,fu)
c     =================================================================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( fln10 = 2.302585, floge = .4342945 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /x_opal_z/ z_opal, x_opal, xc_opal, xo_opal, slt_opal,
     $     slr_opal, fcn_opal, fcon_opal, fcnone_opal, fu_opal
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
c /opalmixes/: --> data{ALL BUT xofe_opalmixes}
c-implicit;      real*4 xiz_mix,fninz_mix,bracketife_mix,bracketofe_opalmixes,
c-implicit;     $     xofe_opalmixes,xiz_opalmixes,fninz_opalmixes
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      common /e_opal_z/ opact,dopact,dopacr,dopactd,
     $     fedge,ftredge,fzedge
      save /e_opal_z/
c
      common /tredges_opal_z/ ftlo_edge, fthi_edge, frlo_edge,
     $     frhi_edge, ftcut_edge, frcut_edge, ftr_cut_edge
      save /tredges_opal_z/
c
      parameter ( rcondswlo = -6.0, rcondswdel = 0.5 )
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      common /c_edge_alex/ fkaedgelo, fkaedgehi, fzkaedge
      save /c_edge_alex/
c
      common /c_switch_used_alex/ fopal, falex, dt_fopal, fr_opal,
     $     dr_fr_opal, ft_opal, dt_ft_opal, ftr_opal, ftr_alex,
     $     ialex, iswrho
      save /c_switch_used_alex/
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /c_ini_alex/ z_alex(nzp1_alex),x_alex(nx_alex),
     $     flt_alex(nt_alex),flro_alex(nrlo_alex:nr_alex)
      save /c_ini_alex/
c
      common /c_tsw_ferg/ slt_max_ferg, sltswlo_ferg_def,
     $     sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $     sltswmid_ferg, dltsw2inv_ferg
      save /c_tsw_ferg/
c
      parameter ( badlogkval=1.e+35, badlogklim=20. )
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c-debug[
c-debug;      common /c_debug_kcond/ i_debug_kcond
c-debug;      save /c_debug_kcond/
c-debug]
c===					! we have not yet gotten a good opacity
      opact = badlogkval
      dopact = 0.
      dopacr = 0.
      dopactd = 0.
      fedge = 0.
      ftredge = 1.
      fzedge = 1.
      flkc = badlogkval
c
      z_opal = z
      x_opal = xh
      xc_opal = exC
      xo_opal = exO
      slt_opal = slt
      slr_opal = slr
c
      fcn_opal = fcn
      fcon_opal = fcon
      fcnone_opal = fcnone
      fu_opal = fu
c
      flt = slt + 6.
      flrho = slr + 3. * slt
c
      if ( kavail_alex .eq. 1 ) then
         sltsw_con = max( sltswhi_alex , -2.0 )
         sltswhi_mol = sltswhi_alex
      else
         sltsw_con = -2.0
         sltswhi_mol = sltswhi_ferg
      endif
c								! OPAL only
      if ( kdo_alex .le. 0 .or. slt .ge. sltswhi_mol ) then
c
         ialex = 0
         falex = 0.
         fopal = 1.
c				! or possibly partial or completely Alexander
      else
c
         iswrho = 0
         ialex = -1
c						! check for switchover region
         if ( kavail_alex .gt. 1 ) then
            if ( slt .le. sltswlo_ferg ) then
               ialex = 1
               falex = 1.
               fopal = 0.
               dt_fopal = 0.
            else if ( slt .le. sltswmid_ferg ) then
               dt_fopal = ( slt - sltswlo_ferg ) * dltsw2inv_ferg
               fopal = ( slt - sltswlo_ferg ) * dt_fopal * 0.5
               falex = 1. - fopal
            else
               dt_fopal = ( sltswhi_ferg - slt ) * dltsw2inv_ferg
               falex = ( sltswhi_ferg - slt ) * dt_fopal * 0.5
               fopal = 1. - falex
            endif
         else if ( flt .le. fltswlo_alex ) then
            ialex = 1
            falex = 1.
            fopal = 0.
            dt_fopal = 0.
         else if ( flt .le. fltswmid_alex ) then
            dt_fopal = ( flt - fltswlo_alex ) * dltsw2inv_alex
            fopal = ( flt - fltswlo_alex ) * dt_fopal * 0.5
            falex = 1. - fopal
         else
            dt_fopal = ( fltswhi_alex - flt ) * dltsw2inv_alex
            falex = ( fltswhi_alex - flt ) * dt_fopal * 0.5
            fopal = 1. - falex
         endif
c					 ! if there is a density switchover:
         if ( kavail_alex .eq. 1 .and. isw_rho_alex .gt. 0 ) then
c						   ! highest-RHO: OPAL only:
            if ( flrho .ge. flrhoswhi_alex ) then
c
               ialex = 0
c			  ! else: if RHO-switchover to OPAL (i.e., if high-RHO
c							! but not too low-T):
            else if ( flrho .gt. flrhoswlo_alex .and.
     $              flt .gt. fltswlo_r_alex ) then
c
               iswrho = 1
               ialex = -1
c						      ! get RHO-switch factors
               if ( flrho .le. flrhoswmid_alex ) then
                  dr_fr_opal = ( flrho - flrhoswlo_alex )
     $                 * dlrhosw2inv_alex
                  fr_opal = ( flrho - flrhoswlo_alex )
     $                 * dr_fr_opal * 0.5
               else
                  dr_fr_opal = ( flrhoswhi_alex - flrho )
     $                 * dlrhosw2inv_alex
                  fr_opal = ( flrhoswhi_alex - flrho )
     $                 * dr_fr_opal * 0.5
               endif
c						   ! very low T: switch to Alex
               if ( flt .ge. fltswhi_r_alex ) then
                  dt_ft_opal = 0.
                  ft_opal = 1.
               else if ( flt .le. fltswmid_r_alex ) then
                  dt_ft_opal = ( flt - fltswlo_r_alex )
     $                 * dltsw2inv_r_alex
                  ft_opal = ( flt - fltswlo_r_alex )
     $                 * dt_ft_opal * 0.5
               else
                  dt_ft_opal = ( fltswhi_r_alex - flt )
     $                 * dltsw2inv_r_alex
                  ft_opal = ( fltswhi_r_alex - flt )
     $                 * dt_ft_opal * 0.5
               endif
c
               ftr_opal = ft_opal * fr_opal
               ftr_alex = 1. - ftr_opal
c
            endif
c
         endif
c
      endif
c
c  If OPAL opacities are needed, get them
c
      if ( ialex .le. 0 ) then
c
         call opal_k_only(z,xh,exC,exO,slt,slr,fcn,fcon,fcnone,fu)
c
         if ( fedge .le. 0.0 ) then
c
            if ( level_err .ge. 2 ) then
c
               if ( fzedge .le. 0.0 ) then
                  write(6,10) z
 10               format(' '/' OPAL: Z=',f11.8,
     $                 ' is outside extreme Z-extrapolation range')
                  stop ' STOP -- OPAL Error: bad Z value. '
               else if ( ftredge .gt. 0.0 .and. xh .ge. 0.8 ) then
                  write(6,30) xh
 30               format(' '/' OPAL: X=',f10.6,
     $                 ' > 0.8, but GN93hz X-values unavailable')
                  stop ' STOP -- OPAL Error: X too large. '
               else if ( ( ialex .eq. 0 .or.
     $                 slt .ge. sltswhi_mol ) .and.
     $                 ( kdo_cond .le. 0 .or. slt .lt. sltsw_con .or.
     $                 frlo_edge .le. 0.0 .or. ftlo_edge .le. 0.0 .or.
     $                 ( ( fthi_edge .le. 0.0 .or.
     $                 frhi_edge .le. 0.0 ) .and.
     $                 slr .le. rcondswlo ) ) ) then
                  write(6,20) flt, slr, flrho
 20               format(' '/' OPAL: logT=',f9.6,', logR=',f11.6,
     $                 ' [logRHO=',f11.6,']: beyond matrix edge')
                  stop ' STOP -- OPAL Error: bad T or R value. '
               endif
c
            else if ( fzedge .le. 0.0 ) then
c
               return
c
            else if ( ftredge .le. 0.0 .and.
     $              ( ialex .eq. 0 .or. slt .ge. sltswhi_mol ) .and.
     $              ( kdo_cond .le. 0 .or. slt .lt. sltsw_con .or.
     $              frlo_edge .le. 0.0 .or. ftlo_edge .le. 0.0 .or.
     $              ( ( fthi_edge .le. 0.0 .or.
     $              frhi_edge .le. 0.0 ) .and.
     $              slr .le. rcondswlo ) ) ) then
c
               return
c
            endif
c
         endif
c
      endif
c
c  If Alexander opacities are needed, get them
c
      if ( ialex .ne. 0 ) then
c
         if ( kavail_alex .ne. 1 ) then
c
            call kapferg( slt, slr, xh, z, exC, exO,
     $                    flka, dlkatr, dlkaro, dlkat, fkaedge )
c
         else
c
            call kapalex( flt, flrho, xh, z + exC + exO,
     $                    flka, dlkat, dlkaro, fkaedge )
c
            dlkatr = dlkat + 3.0 * dlkaro
c
            if ( kuse_alex .ge. 4 ) then
               tmp = max( 0.0 , 1.0 - ( abs(exC) + abs(exO) ) * 5.0
     $              / max( z , 0.0001 , z + exC + exO ) )
               fzkaedge = fzkaedge * tmp
               fkaedge = fkaedge * tmp
            endif
c
         endif
c
         if ( ialex .gt. 0 ) then
c
            opact = flka
            dopact = dlkatr
            dopacr = dlkaro
            dopactd = dlkat
            fedge = fkaedge
            ftredge = min( fkaedgelo , fkaedgehi )
            fzedge = fzkaedge
c
         else if ( fkaedge .gt. 0.0 .or. flka .le. badlogklim ) then
c
c					   ! combine molecular, OPAL opacities
c
            if ( iswrho .le. 0 .or. kavail_alex .gt. 1 ) then
c
               fedge = fedge * fopal + fkaedge * falex
               ftredge = ftredge * fopal
     $              + min( fkaedgelo , fkaedgehi ) * falex
               fzedge = fzedge * fopal + fzkaedge * falex
               if ( fedge .le. 0.0 .and. opact .gt. badlogklim ) then
                  opact = flka
                  dopact = dlkatr
                  dopacr = dlkaro
                  dopactd = dlkat
               else
                  opact = opact * fopal + flka * falex
                  dopact = dopact * fopal + dlkatr * falex
     $                 + ( opact - flka ) * dt_fopal
                  dopacr = dopacr * fopal + dlkaro * falex
                  dopactd = dopactd * fopal + dlkat * falex
     $                 + ( opact - flka ) * dt_fopal
               endif
c
            else
c
               if ( fedge .le. 0.0 .and. opact .gt. badlogklim ) then
                  opact = flka
                  dopacr = dlkaro
                  dopactd = dlkat
               else
                  flka = opact * fopal + flka * falex
                  dlkaro = dopacr * fopal + dlkaro * falex
                  dlkat = dopactd * fopal + dlkat * falex
     $                 + ( opact - flka ) * dt_fopal
                  opact = opact * ftr_opal + flka * ftr_alex
                  dopacr = dopacr * ftr_opal + dlkaro * ftr_alex
     $                 + ( opact - flka ) * ft_opal * dr_fr_opal
                  dopactd = dopactd * ftr_opal + dlkat * ftr_alex
     $              + ( opact - flka ) * fr_opal * dt_ft_opal
               endif
c
               fzedge = ( fzedge * fopal + fzkaedge * falex )
     $              * ftr_opal + fzkaedge * ftr_alex
               ftredge = ftredge * ftr_opal + fkaedgelo * ftr_alex
               fedge = max( 0.0 , fzedge * ftredge )
c
               dopact = dopactd + 3. * dopacr
c
            endif
c
         endif
c				    ! low-T: conductive opacities cannot extend
         if ( fedge .le. 0.0 ) then
            if ( level_err .ge. 2 ) then
               if ( fzedge .le. 0.0 ) then
                  write(6,10) z
                  stop ' STOP -- OPAL Error: bad Z value. '
               else if ( ftredge .le. 0.0 ) then
                  write(6,20) flt, slr, flrho
                  stop ' STOP -- OPAL Error: bad T or R value. '
               else if ( xh .ge. 0.8 ) then
                  write(6,30) xh
                  stop ' STOP -- OPAL Error: X too large. '
               endif
               stop ' STOP -- OPAL Error: beyond matrix edge. '
            endif
            return
         endif
c
      endif
c
c  If conductive opacities are needed, get them and combine them with the
c  radiative opacities: 1/Kappa = 1/Kappa_rad + 1/Kappa_cond
c
      if ( kdo_cond .gt. 0 ) then
c					! set flag IDER : from ITOH_REPLACE
         if ( kavail_cond .le. 1 ) then
            if ( itoh_replace .lt. 0 ) then
               ider = -4
            else
               ider = 1
            endif
         else if ( itoh_replace .gt. 1 ) then
            ider = 1
         else if ( itoh_replace .eq. 0 ) then
            ider = -2
         else if ( itoh_replace .eq. 1 ) then
            ider = -1
         else
            ider = -4
         endif
c
         call kapcond( flrho, flt, xh, y, xcn, xon, xneheavy,
     $                 fmuainv, fmueinv, zsqbar, ider,
     $                 flkc, flkct, flkcro, fkcedge, fkcok )
c
         fkcok = max( 0.0 , fkcok )
         fkcedge = max( 0.0 , fkcedge )
c-debug[
c-debug;         if ( i_debug_kcond .gt. 0 ) then
c-debug;            write(6,'(/"FROM kapcond(",10f11.6," 1 ...):")')
c-debug;     $           flrho, flt, xh, y, xcn, xon, xneheavy,
c-debug;     $           fmuainv, fmueinv, zsqbar
c-debug;            write(6,'("  fkcedge=",f10.7,"  fkcok=",f10.7,$)')
c-debug;     $           fkcedge, fkcok
c-debug;         endif
c-debug]
c
c  Conductive opacities cannot extend the Alexander opacity region:
c
         if ( slt .lt. sltsw_con + 0.1 ) fkcok = min( fkcok ,
     $        max( ftredge , ( slt - sltsw_con ) * 10.0 ) )
c
c  At high T, conductive opacities cannot extend OPAL opacities to logR < -6
c  (where T-extrapolation of OPAL opacities may not be reasonable and is not
c  performed) [note that this constraint may have no effect]:
c
         if ( slr - rcondswdel .lt. rcondswlo .and. slt .gt. 2.0 )
     $        fkcok = min( fkcok , max( ftredge ,
     $        ( slr - rcondswlo ) / rcondswdel ) )
c-debug[
c-debug;         if ( i_debug_kcond .gt. 0 ) write(6,
c-debug;     $        '(" -->",f10.7,"  ;  fedge=",f10.7,"  ftredge=",f10.7,$)'
c-debug;     $        ) fkcok, fedge, ftredge
c-debug]
c
c  Set FTREDGE = 1.0 in the radiative-to-conductive switchover density region,
c  even if, strictly speaking, the radiative and conductive opacities do not
c  overlap enough (as long as log T > 4.1).
c
         ftr_use = max( ftredge , min( 1.0 , fkcok ,
     $        ( alt(nt) - slt ) * dfs(nt) + 1.0 ,
     $        ( alr(nr) + 2.0 - slr ) * dfsr(nr) + 1.0 ,
     $        ( slt - sltsw_con ) * 10.0 ) )
c-debug[
c-debug;         if ( i_debug_kcond .gt. 0 ) write(6,'(" -->",f10.7)') ftr_use
c-debug]
c
         if ( flkc .lt. opact - 7.0 ) then
c
            opact = flkc
            dopactd = flkct
            dopacr = flkcro
            fedge = fkcedge
            ftredge = fkcok
            fzedge = 1.0
c
         else if ( flkc .lt. opact ) then
c
            fac = 10.**(flkc-opact)
            opact = flkc-log10(1.+fac)
            dopactd = (flkct+dopactd*fac)/(1.+fac)
            dopacr = (flkcro+dopacr*fac)/(1.+fac)
c
            if ( fac .gt. 0.01 ) then
               fac = ( fac - 0.01 ) / 1.98
               fedge = fkcedge * (1.-fac) + fedge * fac
               ftredge = fkcok * (1.-fac) + ftr_use * fac
               fzedge = 1. + ( fzedge - 1. ) * fac
            else
               fedge = fkcedge
               ftredge = fkcok
               fzedge = 1.0
            endif
c
         else if ( flkc .lt. opact + 7.0 ) then
c
            fac = 10.**(opact-flkc)
            opact = opact-log10(1.+fac)
            dopactd = (dopactd+flkct*fac)/(1.+fac)
            dopacr = (dopacr+flkcro*fac)/(1.+fac)
c
            if ( fac .gt. 0.01 ) then
               fac = ( fac - 0.01 ) / 1.98
               fedge = fedge * (1.-fac) + fkcedge * fac
               ftredge = ftr_use * (1.-fac) + fkcok * fac
               fzedge = fzedge * (1.-fac) + fac
            else if ( fac .gt. 0.001 .and. ftr_use .ne. ftredge ) then
               fac = ( fac - 0.001 ) / 0.009
               ftredge = ftredge * (1.-fac) + ftr_use * fac
            endif
c
         endif
c
         dopact = dopactd + 3. * dopacr
c-debug[
c-debug;         if ( i_debug_kcond .gt. 0 ) write(6,
c-debug;     $        '("    ==>  fedge=",f10.7,"  ftredge=",f10.7)')
c-debug;     $         fedge, ftredge
c-debug]
c
      endif
c
      if ( fedge .le. 0.0 .and. level_err .ge. 2 ) then
         if ( fzedge .le. 0.0 ) then
            write(6,10) z
            stop ' STOP -- OPAL Error: bad Z value. '
         else if ( ftredge .le. 0.0 ) then
            write(6,20) flt, slr, flrho
            stop ' STOP -- OPAL Error: bad T or R value. '
         else
            write(6,40) flt, slr, z, xh
 40         format(' '/' OPAL: logT',f9.6,' logR',f11.6,' Z',f11.9,
     $           ' or X',f10.7,' is beyond edge')
            stop ' STOP -- OPAL Error: beyond matrix edge. '
         endif
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine z_fcno( x,xmet,nmet,fu, z,exC,exO, y,xCN,xON,xNeHeavy,
     $                   fmuainv,fmueinv,zsqbar, fcn,fcon,fcnone,fuse )
c     =================================================================
c
c.....Given  X, XMET(NMET), and FU  : calculates and returns the values of
c     Z = metallicity, EXC = exC, EXO = exO,  FCN, FCON, FCNONE, FUSE (opacity
c     shift factors used by subroutines OPAL_X_CNO_FU and OPAL_F_XCON_CNOU
c     below);  also Y, XCN = C + N/2, XON = O + N/2, XNEHEAVY = 1-X-Y-XCN-XON,
c     FMUAINV = 1/mu_A = sum{Xi/Ai}. FMUEINV = 1/mu_e = sum{Xi*Zi/Ai},
c     ZSQBAR = sum{Xi*Zi^2/Ai} (needed only for conductive opacities).
c
      dimension xmet(nmet)
c
      parameter ( small_1m6=1.e-6, small_1m8=1.e-8 )
c
      parameter ( small_1m5=1.e-5, small_1m4=1.e-4 )
c
      parameter ( small_m1m6=-1.e-6, small_m1m8=-1.e-8 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mo_m2=mo-2 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      parameter ( n_mix_meteor = 3 )
      double precision xiz_meteor, fninz_meteor
      character*255 cfile_meteor(n_mix_meteor)
      common /c_meteor_mix_opal_z/ xiz_meteor(nel_zmix,n_mix_meteor),
     $     fninz_meteor(nel_zmix,n_mix_meteor),
     $     nuc_charge_opalmixes(nel_zmix), cfile_meteor
      save /c_meteor_mix_opal_z/
c
      common /cno_delta_opal_z/ fcno_mul(4), fninz_cno(nel_zmix,5),
     $     xiz_cno(nel_zmix,5), d_fninz_user(nel_zmix),
     $     fcno_fac(0:3,4), fninz_heavy, xiz_heavy, d_fninz_u_heavy,
     $     s_ninzai_mix, ds_ninzai_u, fn_o_over_cno, fninz_co_mix
      save /cno_delta_opal_z/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c___
      parameter ( atwt_H = 1.0079, atwt_He = 4.0026 )
c
      dimension fninz_u(nel_zmix), xiz_u(nel_zmix), fninz(nel_zmix)
c
c PARAMETERS: for use in call to READZEXCO, if it is called from here:
c  k_hz = 1 = khighz value for READZEXCO ("use 'GN93hz' in Z-interpolation,
c               but no CNO-interpolation")
c  ofe_brack = 0.0 = [O/Fe] value for READZEXCO
c
      parameter ( k_hz=1, ofe_brack=0.0 )
c===
c
c  Perform checks on the inputs, and compute total mass Ztot of metals.
c
      if ( nmet .lt. 5 ) then
         write(6,10) nmet
 10      format(' '/' OPAL_X_CNO_FU Error: metals array',
     $        ' Xmet(Nmet): size too small: Nmet =',i2,' < 5')
         stop ' STOP -- OPAL Error: bad composition (Xmet array size) '
      else if ( level_err .gt. 2 .and.
     $        nmet .ne. nel_zmix .and. kdo_cno .gt. 0 ) then
         write(6,15) nmet, nel_zmix
 15      format(' '/' OPAL_X_CNO_FU Error: metals array',
     $        ' Xmet(Nmet): Nmet =',i5,', but nel_zmix =',i3)
         stop ' STOP -- OPAL Error: bad composition (Xmet array size) '
      endif
c
      ximin = min( x , xmet(1) , xmet(2) , xmet(3) , xmet(4) )
      Zheavy = 0.0
      do i = 5, nmet
         Zheavy = Zheavy + xmet(i)
         ximin = min( ximin , xmet(i) )
      enddo
      Ztot = Zheavy + xmet(1) + xmet(2) + xmet(3) + xmet(4)
c
      xCN = xmet(1) + 0.5 * xmet(2)
      xON = xmet(3) + 0.5 * xmet(2)
      xNeHeavy = Zheavy + xmet(4)
      y = 1. - x - Ztot
c
      if ( min( Ztot , ximin , y , xCN , xON , xNeHeavy ) .lt.
     $     small_m1m6 .or. Zheavy .lt. small_m1m8 ) then
         write(6,20) x, Ztot, Zheavy, ( xmet(i), i = 1, nmet )
 20      format(' '/' OPAL_X_CNO_FU Error: bad X',f10.7,
     $        ' Ztot',f10.7,' Zheavy',f11.8,' ... Xmet'/6f12.8)
         stop ' STOP -- OPAL Error: bad composition. '
      endif
c
c..... If necessary, read data files and do initializations, using READZEXCO
c      (this performs initializations necessary for calculating quantities
c      further below); note that xiz_mix is initialized by a data statement
c      to 'GN93hz' relative-metal-abundance values
c
      if ( itime .ne. 12345678 ) then
c					 ! first get approximate Z using the
c					 ! 'GN93hz' relative metal abundances
         if ( Ztot .le. small_1m6 ) then
            z = max( Ztot , 0.0 )
         else
            xiz_heavy_u = 0.0
            do i = 5, nel_zmix
               xiz_heavy_u = xiz_heavy_u + xiz_mix(i)
            enddo
            z = max( Zheavy / xiz_heavy_u , small_1m6 )
         endif
c		       ! read opacities: use 'GN93hz', but no CNO-interpolation
c							    ! will be possible:
         call readzexco(nz,-1.,z,-1.,k_hz,-1,ofe_brack)
c
      endif
c
      fmuainv = x / atwt_h + y / atwt_he
      fmueinv = x / atwt_h + y * 2. / atwt_he
      zsqbar = x / atwt_h + y * 4. / atwt_he
c
c  If there are essentially no metals (except perhaps C,N,O,Ne), there is no
c  point in trying to do anything fancy with interpolation in the make-up of Z.
c
      if ( Ztot .le. small_1m6 .or. Zheavy .le. small_1m8 ) then
c
         fuse = 0.0
         fcn = 0.0
         fcon = 0.0
         fcnone = 0.0
c				      ! for very small Z, this is good enough:
         if ( Ztot .le. small_1m6 ) then
            z = max( Ztot , 0.0 )
         else
            z = max( Zheavy / xiz_heavy , small_1m6 )
         endif
c					    ! any excess C,N,O,Ne --> EXC, EXO:
         exC = xmet(1) - z * xiz_mix(1)
     $        + 0.5 * ( xmet(2) - z * xiz_mix(2) )
         exO = xmet(3) + xmet(4)
     $        - z * ( xiz_mix(3) + xiz_mix(4) )
     $        + 0.5 * ( xmet(2) - z * xiz_mix(2) )
c
         fmuainv = fmuainv + xmet(1) / atwt_opalGS98(1)
     $        + xmet(2) / atwt_opalGS98(2) + xmet(3) / atwt_opalGS98(3)
     $        + xmet(4) / atwt_opalGS98(4) + Zheavy / 40.
         fmueinv = fmueinv + xmet(1) * 6. / atwt_opalGS98(1)
     $        + xmet(2) * 7. / atwt_opalGS98(2)
     $        + xmet(3) * 8. / atwt_opalGS98(3)
     $        + xmet(4) * 10. / atwt_opalGS98(4) + Zheavy * 0.5
         zsqbar = zsqbar + xmet(1) * 36. / atwt_opalGS98(1)
     $        + xmet(2) * 49. / atwt_opalGS98(2)
     $        + xmet(3) * 64. / atwt_opalGS98(3)
     $        + xmet(4) * 100. / atwt_opalGS98(4) + Zheavy * 10.
c
c  OTHERWISE: if the total amount of metals is not insignificant:
c
      else
c
c  First get a mix to use for FMUAINV, FMUEINV, ZSQBAR
c
         do i = 1, min( nmet , nel_zmix )
            xiz_u(i) = xmet(i)
         enddo
         if ( nmet .gt. nel_zmix ) then
            do i = nel_zmix + 1, nmet
               xiz_u(kel_fe) = xiz_u(kel_fe) + xmet(i)
            enddo
         else
            xiz_heavy_u = 0.0
            do i = nmet, nel_zmix
               xiz_heavy_u = xiz_heavy_u + xiz_mix(i)
               xiz_u(i) = xmet(nmet) * xiz_mix(i)
            enddo
            if ( xiz_heavy_u .gt. 0.0 ) then
               do i = nmet, nel_zmix
                  xiz_u(i) = xiz_u(i) / xiz_heavy_u
               enddo
            endif
         endif
c
         do i = 1, nel_zmix
            fmuainv = fmuainv + xiz_u(i) / atwt_opalGS98(i)
            fmueinv = fmueinv + xiz_u(i) * nuc_charge_opalmixes(i)
     $           / atwt_opalGS98(i)
            zsqbar = zsqbar + xiz_u(i) * nuc_charge_opalmixes(i)**2
     $           / atwt_opalGS98(i)
         enddo
c
c  Obtain the OPAL reference mix (relative to Z) in both number and mass
c  fractions, and the fraction of these that correspond to elements heavier
c  than Ne; note that this reference mix can be affected by the composition
c  of the user-specified opacity-shift file, if this is being used.
c
         if ( kdo_user .le. 0 .or. abs(fu) .lt. small_1m6 ) then
c								! no fu effect:
            fuse = 0.0
            do i = 1, nel_zmix
               fninz_u(i) = fninz_mix(i)
               xiz_u(i) = xiz_mix(i)
            enddo
            fninz_heavy_u = fninz_heavy
            xiz_heavy_u = xiz_heavy
c				   ! else: include fu effect, if it is non-zero
         else
c			! don't allow too much heavy-element reduction from fu
c
            fuse = max( -2.0 , min( 2.0 , fu ) )
            fninz_heavy_u = fninz_heavy + fuse * d_fninz_u_heavy
            if ( fninz_heavy_u .lt. 0.5 * fninz_heavy ) then
               if ( fu .lt. -0.2 ) then
                  fuse = min( -0.2 ,
     $                 -0.5 * fninz_heavy / d_fninz_u_heavy )
                  fninz_heavy_u = fninz_heavy + fuse * d_fninz_u_heavy
               else if ( fu .gt. 1.2 ) then
                  fuse = max( 1.2 ,
     $                 -0.5 * fninz_heavy / d_fninz_u_heavy )
                  fninz_heavy_u = fninz_heavy + fuse * d_fninz_u_heavy
               endif
            endif
c				! get shifted composition using fu-factor fuse
            sum_niai = 0.0
            do i = 1, nel_zmix
               fninz_u(i) = fninz_mix(i) + fuse * d_fninz_user(i)
               xiz_u(i) = fninz_u(i) * atwt_opalGS98(i)
               sum_niai = sum_niai + xiz_u(i)
            enddo
c
            xiz_u(1) = xiz_u(1) / sum_niai
            xiz_u(2) = xiz_u(2) / sum_niai
            xiz_u(3) = xiz_u(3) / sum_niai
            xiz_u(4) = xiz_u(4) / sum_niai
c
            xiz_heavy_u = 0.0
            do i = 5, nel_zmix
               xiz_u(i) = xiz_u(i) / sum_niai
               xiz_heavy_u = xiz_heavy_u + xiz_u(i)
            enddo
c
         endif
c
c  If CNO-interpolation is not available, then all we have to do now is to
c  compute the metallicity Z and the excess C and O amounts:
c
         if ( kdo_cno .le. 0 ) then
c					! no CNO-interpolation: factors are 0.0
            fcn = 0.0
            fcon = 0.0
            fcnone = 0.0
c						  ! heavies give metallicity Z
            z = max( Zheavy / xiz_heavy_u , 0.0 )
c						 ! excess C,N,O,Ne --> EXC, EXO
            exC = xmet(1) - z * xiz_u(1)
     $           + 0.5 * ( xmet(2) - z * xiz_u(2) )
            exO = xmet(3) + xmet(4)
     $           - z * ( xiz_u(3) + xiz_u(4) )
     $           + 0.5 * ( xmet(2) - z * xiz_u(2) )
c
c  ELSE, if CNO-interpolation is available: determine the CNO-interpolation
c  factors as well as the metallicity Z and the excess C and O amounts:
c
         else
c
c.....Get the factor f_nz that converts fractions of Z to the actual mass
c     fractions, and use it to convert the input mass fractions to adjusted
c     number fractions of Z (the CNO-mix) --- if the user-fraction  fu  is
c     non-zero, subtract off the effects of the difference in composition
c     between the user-opacity-file and the OPAL mix (multiplied by fu).
c
c  NOTE: for OPAL-mix(Z): SUM_z{ Xmix_i } = Z, SUM_z{ fninz_mix(i) } = 1.0,
c
c                 SUM_h{ Xmix_i } = Zheavy, SUM_h{ fninz_mix(i) } = fninz_heavy
c
c             where  fninz_mix(i) = ( Xmix_i / A_i ) / SUM_z{ Xmix_j / A_j } so
c
c                fninz_heavy = SUM_h{ Xmix_i / A_i } / SUM_z{ Xmix_j / A_j } .
c
c					    ! If user supplies OPAL-element Xi:
            if ( nmet .eq. nel_zmix ) then
c
c        For input-mix with same number of elements as OPAL-mix, assume that
c                  SUM_h{ fninz(i) } = fninz_heavy  is what determines Z, i.e.,
c                    fninz_heavy = SUM_h{ X_i / A_i } / SUM_z{ Xmix_j / A_j }
c                  i.e., assume  SUM_h{ X_i / A_i } = SUM_h{ Xmix_i / A_i } .
c             But  SUM_z{ fninz(i) }  is NOT necessarily equal to 1.0, since
c             there may be excess C and O.  We therefore set
c                f_nz = SUM_h{ X_i / A_i } / fninz_heavy
c                     = SUM_h{ X_i / A_i }
c                          / [ SUM_h{ Xmix_i / A_i } / SUM_z{ Xmix_j / A_j } ]
c                     = SUM_z{ Xmix_j / A_j }
c             due to our assumption  SUM_h{ X_i / A_i } = SUM_h{ Xmix_i / A_i }
c             and thus we set
c                fninz(i) = X_i / ( f_nz * A_i )
c                         = ( X_i / A_i ) / SUM_z{ Xmix_i / A_i }
c             which is what we want.
c						! get metallicity factor f_nz
               f_nz = 0.0
               do i = 5, nel_zmix
                  f_nz = f_nz + xmet(i) / atwt_opalGS98(i)
               enddo
               f_nz = f_nz / fninz_heavy_u
c						! and use it to get CNO-mix
               do i = 1, nel_zmix
                  fninz(i) = xmet(i) / ( f_nz * atwt_opalGS98(i) )
     $                 - fuse * d_fninz_user(i)
               enddo
c					     ! Else: non-OPAL-Xi, but fu = 0.0:
            else if ( fuse .eq. 0.0 ) then
c
c       For input-mix with different number of elements from OPAL-mix, assume
c                 SUM_h{ X_i } = SUM_h{ Xmix_i } = Zheavy .
c             But  xiz_heavy = SUM_h{ Xmix_i / Z } = Zheavy / Z , and
c                  s_ninzai_mix = SUM_z{ fninz_mix(i) * A_i }
c                               = SUM_z{ Xmix_i } / SUM_z{ Xmix_j / A_j }
c                               = Z / SUM_z{ Xmix_j / A_j }
c             We therefore set
c                f_nz = Zheavy / ( xiz_heavy * s_ninzai_mix )
c                     = Zheavy
c                          / ( [ Zheavy / Z ] * [ Z / SUM_z{ Xmix_j / A_j } ] )
c                     = SUM_z{ Xmix_j / A_j }
c             and thus for the non-heavies we set
c                fninz(i) = X_i / ( f_nz * A_i )
c                         = ( X_i / A_i ) / SUM_z{ Xmix_i / A_i }
c             which is what we want (for the heavies, we assume that they are
c             distributed as in the OPAL-mix).
c								! get f_nz
               f_nz = Zheavy / ( xiz_heavy_u * s_ninzai_mix )
c								! and CNO-mix
               do i = 1, 4
                  fninz(i) = xmet(i) / ( f_nz * atwt_opalGS98(i) )
               enddo
               do i = 5, nel_zmix
                  fninz(i) = fninz_mix(i)
               enddo
c					   ! Else: non-OPAL-Xi and non-zero fu:
            else
c								! get f_nz
               f_nz = Zheavy / ( xiz_heavy_u
     $              * ( s_ninzai_mix + fuse * ds_ninzai_u ) )
c								! and CNO-mix
               do i = 1, 4
                  fninz(i) = xmet(i) / ( f_nz * atwt_opalGS98(i) )
     $                 - fuse * d_fninz_user(i)
               enddo
               do i = 5, nel_zmix
                  fninz(i) = fninz_mix(i)
               enddo
c
            endif
c
c.....Get the number fraction differences between the adjusted CNO-mix and the
c     original OPAL-mix.  Any excess in the sum of N + Ne abundances must come
c     from C and/or O depletion, so use the former to get these latter amounts.
c     Note that any Ne increase is expected to come from both C and O, so set
c     a preliminary O depletion to be the amount of the Ne increase multiplied
c     by the initial ratio of O to the sum of C,N,O.  If this is larger than
c     the initial O abundance, reduce the excess O depletion (i.e., the amount
c     of O-depletion beyond the initial O abundance) by a factor of 10 (this
c     is equivalent to assuming that the third dredge-up yields an order of
c     magnitude larger C increase than the O increase).  Most or all of the
c     difference between the total N + Ne increase and this (prelimiary) O
c     depletion should be assigned to C depletion (but the O depletion may need
c     a slight readjustment).  Adjust the excess C and O amounts according to
c     these C and O depletions; but if the total excess CO is positive, do not
c     allow either of the C excess or the O excess to be negative --- note that
c     this condition may cause a readjustment of the C and O depletions.
c
c					   ! get CNO-mix - OPAL-mix differences
            dn_c = fninz(1) - fninz_mix(1)
            dn_n = fninz(2) - fninz_mix(2)
            dn_o = fninz(3) - fninz_mix(3)
            dn_ne = fninz(4) - fninz_mix(4)
c					    ! total increase in N + Ne
            deln_nne = dn_ne + dn_n
c						! total excess CO (by number)
            fn_co_ex = dn_c + dn_o + deln_nne
c						! If have negligible excess CO:
            if ( fn_co_ex .lt. small_1m4 ) then
c						! just divide it equally in C,O
               fn_c_ex = 0.5 * fn_co_ex
               fn_o_ex = fn_c_ex
               deln_c = fn_c_ex - dn_c
               deln_o = fn_o_ex - dn_o
c						! Else: have some excess CO:
            else
c						 ! If negligible N+Ne increase:
               if ( deln_nne .lt. small_1m5 ) then
c						   ! divide it equally in C,O
                  deln_c = 0.5 * deln_nne
                  deln_o = deln_c
c				       ! Else: both C,O --> N,Ne and excess CO:
               else
c					     ! any Ne increase is partly from O
                  if ( dn_ne .gt. 0.0 ) then
                     deln_o = fn_o_over_cno * dn_ne
                     if ( deln_o .gt. fninz_mix(3) )
     $                    deln_o = fninz_mix(3)
     $                    + 0.1 * ( deln_o - fninz_mix(3) )
                     deln_rem = deln_nne - deln_o
                  else
                     deln_o = 0.0
                     deln_rem = deln_nne
                  endif
c						     ! If not much (more) N+Ne:
c
                  if ( deln_rem .le. fninz_mix(1) ) then
c							 ! assign it to C
                     deln_c = deln_rem
c				      ! Else if N+Ne increase is < initial C+O:
c
                  else if ( deln_nne .le. fninz_co_mix ) then
c								    ! divide it
                     deln_o = max( deln_nne - fninz_mix(1) , deln_o )
                     deln_c = deln_nne - deln_o
c						 ! Else if large N+Ne increase:
                  else
c							   ! most is from C
                     deln_o = max( fninz_mix(3) , deln_o )
                     deln_c = deln_nne - deln_o
c
                  endif
c
               endif
c				! adjust the excess C and O amounts according
c					! to the above C and O depletions
               fn_c_ex = dn_c + deln_c
               fn_o_ex = dn_o + deln_o
c					! but total excess CO is > 0, so do not
c						! allow negative excess C or O
               if ( fn_c_ex .lt. 0.0 ) then
                  deln_c = deln_c - fn_c_ex
                  deln_o = deln_o + fn_c_ex
                  fn_o_ex = fn_o_ex + fn_c_ex
                  fn_c_ex = 0.0
               else if ( fn_o_ex .lt. 0.0 ) then
                  deln_c = deln_c + fn_o_ex
                  deln_o = deln_o - fn_o_ex
                  fn_c_ex = fn_c_ex + fn_o_ex
                  fn_o_ex = 0.0
               endif
c
            endif
c
c.....The excess C and O are not part of Z: subtract them off, then use the
c     previously-computed  f_nz  factor to calculate the metallicity Z.  Obtain
c     the excess C and O mass fractions EXC and EXO from the excess C and O
c     number fractions.  Use pre-calculated interpolation factors to get the
c     CNO-interpolation factors FCN, FCON, FCNONE from the C, N, and O number
c     fractions (relative to Z) that have just been computed (if all three of
c     these CNO-interpolation factors are very small, set them to zero).
c
c					  ! subtract off excess C, O by number
            fninz(1) = fninz(1) - fn_c_ex
            fninz(3) = fninz(3) - fn_o_ex
c					  ! compute metallicity mass fraction Z
            z = 0.0
            do i = 1, nel_zmix
               z = z + ( fninz(i) + fuse * d_fninz_user(i) )
     $              * atwt_opalGS98(i)
            enddo
            z = max( z * f_nz , 0.0 )
c						    ! excess C,O mass fractions
            exC = fn_c_ex * atwt_opalGS98(1) * f_nz
            exO = fn_o_ex * atwt_opalGS98(3) * f_nz
c							     ! for CNO-interp:
            fcn = ( fcno_fac(0,2) + fcno_fac(1,2) * fninz(1)
     $           + fcno_fac(2,2) * fninz(2)
     $           + fcno_fac(3,2) * fninz(3) ) * fcno_mul(2)
            fcon = ( fcno_fac(0,3) + fcno_fac(1,3) * fninz(1)
     $           + fcno_fac(2,3) * fninz(2)
     $           + fcno_fac(3,3) * fninz(3) ) * fcno_mul(3)
            fcnone = ( fcno_fac(0,4) + fcno_fac(1,4) * fninz(1)
     $           + fcno_fac(2,4) * fninz(2)
     $           + fcno_fac(3,4) * fninz(3) ) * fcno_mul(4)
c								! very small?
            if ( max( abs(fcn) , abs(fcon) , abs(fcnone) ) .lt.
     $           small_1m5 .or. z .lt. small_1m6 ) then
               fcn = 0.0
               fcon = 0.0
               fcnone = 0.0
            endif
c
         endif
c
      endif
c
c  Check for exC, exO too large or too negative.
c
      del_sum = ( x + z + exC + exO - 1.0 ) * 0.5d0
      if ( del_sum .gt. 0.0 ) then
         exC = exC - del_sum
         exO = exO - del_sum
      endif
c
      if ( exC .lt. -0.5 * z ) then
         exO = max( -0.5 * z , exO + ( exC + 0.5 * z ) )
         exC = -0.5 * z
      else if ( exO .lt. -0.5 * z ) then
         exC = max( -0.5 * z , exC + ( exO + 0.5 * z ) )
         exO = -0.5 * z
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine kapferg( slt, slr, xh, z, exC, exO,
     $                    flka, dlkatr, dlkaro, dlkat, fkaedge )
c     ==========================================================
c
      parameter ( small_1m6=1.e-6, small_m1m6=-1.e-6, small_5m7=5.e-7 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /mat_alex_ferg/ flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg)
      save /mat_alex_ferg/
c
      common /opac_ferg/ zlog_ferg(nzp1_ferg), xlog_ferg(nx_ferg),
     $     dzinvlog_ferg(nz_ferg), dzinv_ferg(nz_ferg),
     $     dxinvlog_ferg(nx_ferg), dxinv_ferg(nx_ferg),
     $     t6log_ferg(nt_ferg), rlog_ferg(nr_ferg),
     $     dt6inv_ferg(nt_ferg), drinv_ferg(nr_ferg),
     $     modt_ferg, modz0_ferg, ntuferg
      save /opac_ferg/
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_prev_ferg/ zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $     zlp2_ferg, xp2_ferg, i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
      save /c_prev_ferg/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_edge_alex/ fkaedgelo, fkaedgehi, fzkaedge
      save /c_edge_alex/
c
c  Note that the following are initialized to valid values when Ferguson et al.
c  molecular opacities are read in, whether from ASCII file or binary dumpfile:
c
      common /c_ferg_indices/ mf, mg, mh, mf2, kf, kg, kh, kf2,
     $     i1, i2, i3, i4, j1, j2, j3, j4
      save /c_ferg_indices/
c
      common/d_opal_z/ dkap
      save /d_opal_z/
c
      parameter ( badlogkval=1.e+35 )
c
      parameter ( nzm1_ferg=nz_ferg-1, nzm2_ferg=nz_ferg-2,
     $     nrm1_ferg=nr_ferg-1 )
c
      dimension h(nx_ferg), g(4), dg(4), needt(4), needr(4)
c
      logical lacc_t, lacc_zf, lacc_xf, lnozlo
c-debug[
c-debug;      common /c_debug_ferg/ i_debug_ferg
c-debug;      save /c_debug_ferg/
c-debug]
c===
c-debug[
c-debug;      if ( i_debug_ferg .gt. 1 ) write(6,'(" ")')
c-debug;      if ( i_debug_ferg .gt. 0 ) write(6,
c-debug;     $     '(" ***** kapferg(",2(a,f11.6),4(a,f11.7),a," ):")')
c-debug;     $     ' slt', slt, ' slr', slr, ' xh', xh, ' z', z,
c-debug;     $     ' exC', exC, ' exC', exO,
c-debug;     $     ' flka, dlkatr, dlkaro, dlkat, fkaedge'
c-debug]
      flka = badlogkval
      dlkatr = 0.0
      dlkaro = 0.0
      dlkat = 0.0
      fkaedge = 0.0
      fkaedgelo = 1.0
      fkaedgehi = 1.0
      fzkaedge = 1.0
c					! have Ferguson et al. 2005 opacities?
      if ( kavail_alex .le. 1 ) return
c
      xzco = z + exC + exO
      zpxc = min( 1.0 , max( xzco , 0.0 ) )
      y = 1.0 - xh - zpxc
c							! check composition
      if ( min( xh , xzco , y ) .le. small_m1m6 ) then
         write(6,10) xh, y, xzco
 10      format(' '/' KAPFERG Error: bad X=',1p,e13.6,
     $        ' Y=1-X-Z-CO=',e13.6,' Z+CO=',e13.6)
         stop ' STOP - KAPFERG: bad { X , Z + exCO } composition . '
      endif
c								! check bounds
      fthi = ( slt - t6log_ferg(1) ) * dt6inv_ferg(1) + 1.0
      ftlo = ( t6log_ferg(ntuferg) - slt ) * dt6inv_ferg(ntuferg) + 1.0
c
      fkaedgelo = max( 0.0 , min( 1.0 , ftlo ,
     $     ( slr - rlog_ferg(1) ) * drinv_ferg(1) + 1.0 ) )
      fkaedgehi = max( 0.0 , min( 1.0 , fthi ,
     $     ( rlog_ferg(nr_ferg) - slr ) * drinv_ferg(nr_ferg) + 1.0 ) )
c
      if ( zpxc .gt. z_ferg(nz_ferg) ) fzkaedge = max( 0.0 ,
     $     ( z_ferg(nz_ferg) - zpxc ) * dzinv_ferg(nz_ferg) + 1.0 )
c
      izchk_alex = iabs( kuse_alex )
c
      if ( izchk_alex .ge. 4 ) fzkaedge = fzkaedge
     $     * max( 0.0 , 1.0 - ( abs(exC) + abs(exO) ) * 5.0
     $     / max( z , 0.0001 , z + exC + exO ) )
c
      fkaedge = fzkaedge * min( fkaedgelo, fkaedgehi )
c
      if ( min( fzkaedge , ftlo , fthi ) .le. 0.0 ) return
c
      fzlo = 1.0
c					! these just prevent compiler warnings:
      fzhi = 0.0
      fxlo = 1.0
      fxhi = 0.0
      ftlo = 1.0
      fthi = 0.0
      frlo = 1.0
      frhi = 0.0
c-noXlog;      xlogat = xh
      zlogat = zpxc
c							! get X-indices
      if ( xh .lt. small_1m6 ) then
c
         mf = 1
         mf2 = 1
         mg = 1
         mh = 1
c
      else if ( y .lt. small_1m6 ) then
c
         mf = nx_ferg
         mf2 = nx_ferg
         mg = nx_ferg
         mh = nx_ferg
c
      else
c
         if ( zpxc .ge. z_ferg(nz_ferg) ) then
            ixhi = nxm2_ferg
         else if ( zpxc .ge. z_ferg(n2_ferg) ) then
            ixhi = nxm1_ferg
         else
            ixhi = nx_ferg
         endif
c
         ihi = max( 3 , min( ixhi , mh ) )
         ilo = ihi - 1
         iat = 1
         do while ( ilo .gt. 2 .and. xh .lt. x_ferg(ilo) )
            ihi = ilo
            ilo = max( 2 , ilo - iat )
            iat = iat + iat
         enddo
         do while ( ihi .lt. ixhi .and. xh .gt. x_ferg(ihi) )
            ilo = ihi
            ihi = min( ixhi , ihi + iat )
            iat = iat + iat
         enddo
         do while ( ihi - ilo .gt. 1 )
            iat = ( ihi + ilo ) / 2
            if ( xh .ge. x_ferg(iat) ) then
               ilo = iat
            else
               ihi = iat
            endif
         enddo
c
         if ( abs( x_ferg(ilo) - xh ) .lt. small_1m6 ) then
            mf = ilo
            mf2 = ilo
            mg = ilo
            mh = ilo
         else if ( abs( x_ferg(ihi) - xh ) .lt. small_1m6 ) then
            mf = ihi
            mf2 = ihi
            mg = ihi
            mh = ihi
         else
            x_ferg(nx_ferg) = 1.0 - zpxc
            if ( xh .gt. x_ferg(ilo) ) then
               mf2 = min( ihi + 1 , ixhi )
            else
               mf2 = ihi
            endif
            if ( mf2 .eq. ihi .or. xh .lt. x_ferg(ihi) ) then
               mf = ilo - 1
               mg = ilo
               mh = ihi
            else
               mf = ilo
               mg = ihi
               mh = mf2
            endif
         endif
c
         if ( ixhi .lt. nx_ferg ) then
            if ( mf2 .eq. ixhi ) mf2 = nx_ferg
            if ( mh .eq. ixhi ) mh = nx_ferg
            if ( mg .eq. ixhi ) mg = nx_ferg
            if ( mf .eq. ixhi ) mf = nx_ferg
         endif
c
c-noXlog;         if ( mf .le. 2 .and. mf2 .gt. mf )
c-noXlog;     $        xlogat = log10( xh + xdel_ferg )
c
         if ( mf2 .gt. mh ) then
c-noXlog;            if ( mg .eq. 2 ) then
c-noXlog;               fxlo = max( 0.0 , min( 1.0 ,
c-noXlog;     $              ( xlog_ferg(mh) - xlogat ) * dxinvlog_ferg(mh) ) )
c-noXlog;            else
            fxlo = max( 0.0 , min( 1.0 ,
     $           ( x_ferg(mh) - xh ) * dxinv_ferg(mh) ) )
c-noXlog;            endif
            fxhi = 1.0 - fxlo
         endif
c
      endif
c							! get Z-indices
      if ( zpxc .lt. z0_ferg ) then
c
         kf = 1
         kg = 1
         kh = 1
         kf2 = 1
         zlogat = zlog_ferg(1)
c
      else
c
         ihi = max( 3 , min( nz_ferg , kh ) )
         ilo = ihi - 1
         iat = 1
         do while ( ilo .gt. 2 .and. zpxc .lt. z_ferg(ilo) )
            ihi = ilo
            ilo = max( 2 , ilo - iat )
            iat = iat + iat
         enddo
         do while ( ihi .lt. nz_ferg .and. zpxc .gt. z_ferg(ihi) )
            ilo = ihi
            ihi = min( nz_ferg , ihi + iat )
            iat = iat + iat
         enddo
         do while ( ihi - ilo .gt. 1 )
            iat = ( ihi + ilo ) / 2
            if ( zpxc .ge. z_ferg(iat) ) then
               ilo = iat
            else
               ihi = iat
            endif
         enddo
c
         if ( abs( z_ferg(ilo) - zpxc ) .lt. small_1m6 * zpxc ) then
            kf = ilo
            kg = ilo
            kh = ilo
            kf2 = ilo
            zlogat = zlog_ferg(ilo)
         else if ( abs( z_ferg(ihi) - zpxc ) .lt.
     $           small_1m6 * zpxc ) then
            kf = ihi
            kg = ihi
            kh = ihi
            kf2 = ihi
            zlogat = zlog_ferg(ihi)
         else
            kf = ilo - 1
            kg = ilo
            kh = ihi
            zlogat = log10( zpxc + zdel_ferg )
            if ( ihi .ge. nz_ferg .or. zpxc .le. z_ferg(ilo) ) then
               kf2 = ihi
               if ( iacc_ferg .gt. 0 .and. ihi .eq. nz_ferg ) then
                  kf2 = nzp1_ferg
                  fzlo = max( 0.0 , min( 1.0 ,
     $                 ( zlog_ferg(nz_ferg) - zlogat )
     $                 * dzinvlog_ferg(nz_ferg) ) )
                  fzhi = 1.0 - fzlo
               endif
            else
               kf2 = ihi + 1
               fzlo = max( 0.0 , min( 1.0 ,
     $              ( zlog_ferg(kh) - zlogat ) * dzinvlog_ferg(kh) ) )
               fzhi = 1.0 - fzlo
            endif
         endif
c
      endif
c
      if ( fzlo .le. 0.0 ) then
         lnozlo = .true.
      else
         lnozlo = .false.
      endif
c		! get T-indices: note: from previous: 1 < i2 = i3 - 1 < ntuferg
      iat = 1
      do while ( i3 .lt. ntuferg .and. slt .lt. t6log_ferg(i3) )
         i2 = i3
         i3 = min( ntuferg , i3 + iat )
         iat = iat + iat
      enddo
      do while ( i2 .gt. 2 .and. slt .gt. t6log_ferg(i2) )
         i3 = i2
         i2 = max( 2 , i2 - iat )
         iat = iat + iat
      enddo
      do while ( i3 - i2 .gt. 1 )
         iat = ( i2 + i3 ) / 2
         if ( slt .le. t6log_ferg(iat) ) then
            i2 = iat
         else
            i3 = iat
         endif
      enddo
c
      i1 = i2 - 1
      if ( i3 .ge. ntuferg .or. slt .ge. t6log_ferg(i2) ) then
         i4 = i3
      else
         i4 = i3 + 1
         ftlo = max( 0.0 , min( 1.0 ,
     $        ( t6log_ferg(i3) - slt ) * dt6inv_ferg(i3) ) )
         fthi = 1.0 - ftlo
      endif
c		! get R-indices: note: from previous: 0 < j2 = j3 - 1 < nr_ferg
      iat = 1
      do while ( j2 .gt. 1 .and. slr .lt. rlog_ferg(j2) )
         j3 = j2
         j2 = max( 1 , j2 - iat )
         iat = iat + iat
      enddo
      do while ( j3 .lt. nr_ferg .and. slr .gt. rlog_ferg(j3) )
         j2 = j3
         j3 = min( nr_ferg , j3 + iat )
         iat = iat + iat
      enddo
      do while ( j3 - j2 .gt. 1 )
         iat = ( j2 + j3 ) / 2
         if ( slr .ge. rlog_ferg(iat) ) then
            j2 = iat
         else
            j3 = iat
         endif
      enddo
c			! note: may have j1 = 0 or j4 = nr_ferg + 1
      j1 = j2 - 1
      if ( slr .le. rlog_ferg(j2) ) then
         j4 = j3
      else
         j4 = j3 + 1
         frlo = max( 0.0 , min( 1.0 ,
     $        ( rlog_ferg(j3) - slr ) * drinv_ferg(j3) ) )
         frhi = 1.0 - frlo
         if ( frhi .le. 0.0 ) j4 = j3
      endif
c			! by default, Z,X-interp is needed at each T-value
      needt(1) = 1
      needt(2) = 1
      needt(3) = 1
      needt(4) = 1
c			! by default, Z,X-interp is needed at each R-value
      needr(1) = 1
      needr(2) = 1
      needr(3) = 1
      needr(4) = 1
c
      nzp_sto = nz_ferg
c					! if first full-T-R-cache (of stored
c					! Z,X-interp values) was computed and
c							 ! matches X,Z, use it:
      if ( abs( zlogat - zlp1_ferg ) .le. small_1m6 .and.
     $     abs( xh - xp1_ferg ) .le. small_5m7 ) then
c
         nzp_sto = nzm1_ferg
         needall = 0
c						! else if second full-T-R-cache
c								! matches X,Z:
      else if ( abs( zlogat - zlp2_ferg ) .le. small_1m6 .and.
     $        abs( xh - xp2_ferg ) .le. small_5m7 ) then
c
         nzp_sto = nzm2_ferg
         needall = 0
c			! else if NO stored Z,X-interp values are O.K. for use
c			! (i.e., Z or X has changed, or there is no T-overlap
c							    ! or no R-overlap):
      else if ( i1 .gt. i4p_ferg .or. i4 .lt. i1p_ferg .or.
     $        j1 .gt. j4p_ferg .or. j4 .lt. j1p_ferg .or.
     $        abs( zlogat - zlogp_ferg ) .gt. small_1m6 .or.
     $        abs( xh - xp_ferg ) .gt. small_5m7 ) then
c
         needall = 1
c			! else if stored Z,X-interp values suffice (no new
c								! ones needed):
      else if ( i1 .ge. i1p_ferg .and. i4 .le. i4p_ferg .and.
     $        max( 1 , j1 ) .ge. j1p_ferg .and.
     $        min( nr_ferg , j4 ) .le. j4p_ferg ) then
c
         needall = 0
c			! else (if some new Z,X-interp values must be stored):
      else
c
         needall = -1
c							 ! find T-overlap
         i0 = i1 - 1
         do i = max( i1, i1p_ferg ), min( i4, i4p_ferg )
            needt(i-i0) = 0
         enddo
c							 ! find R-overlap
         i0 = j1 - 1
         do i = max( j1, j1p_ferg ), min( j4, j4p_ferg )
            needr(i-i0) = 0
         enddo
c
      endif
c-debug[
c-debug;      if ( i_debug_ferg .gt. 1 ) then
c-debug;         write(6,'(2(a,f11.7),4(a,f11.7),a,i3)')
c-debug;     $        '    zpxc=', zpxc, '  y=', y, ' fkaedgelo=', fkaedgelo,
c-debug;     $        ' fkaedgehi=', fkaedgehi, ' fzkaedge=', fzkaedge,
c-debug;     $        ' fkaedge=', fkaedge, '  iacc_ferg=', iacc_ferg
c-debug;         write(6,'(a,4i3,a,f11.6,a,4f11.6)')
c-debug;     $        '    kf,g,h,f2=', kf, kg, kh, kf2, ' zlogat=', zlogat,
c-debug;     $        ' zlog_ferg(kf:kf2)',
c-debug;     $        ( zlog_ferg(i), i = kf, min(kf2,nz_ferg) )
c-debug;         if ( mf2 .le. mh ) then
c-debug;            write(6,'(a,4i3,a,f11.7,a,4f11.7)')
c-debug;     $           '    mf,g,h,f2=', mf, mg, mh, mf2, ' x=', xh,
c-debug;     $           ' x_ferg(mf:mf2)', ( x_ferg(i), i = mf, mh )
c-debug;         else
c-debug;            write(6,'(a,4i3,a,f11.7,a,4f11.7)')
c-debug;     $           '    mf,g,h,f2=', mf, mg, mh, mf2, ' x=', xh,
c-debug;     $           ' x_ferg(mf:mf2)', ( x_ferg(i), i = mf, mh ),
c-debug;     $           x_ferg(mf2)
c-debug;         endif
c-debug;         write(6,'(2(a,4i3),a,f11.6,a,4f11.6)')
c-debug;     $        '    j1:4=', j1, j2, j3, j4,
c-debug;     $        '  needr(1:4)=', (needr(i),i=1,4),
c-debug;     $        '  logR=', slr, ' logR_ferg(j1:j4)=',
c-debug;     $        ( rlog_ferg(i), i = max(1,j1), min(nr_ferg,j4) )
c-debug;         write(6,'(2(a,4i3),a,f11.7,a,4f11.7)')
c-debug;     $        '    i1:4=', i1, i2, i3, i4,
c-debug;     $        '  needt(1:4)=', (needt(i),i=1,4),
c-debug;     $        '  logT=', slt + 6.0, ' logT_ferg(i1:i4)=',
c-debug;     $        ( t6log_ferg(i) + 6.0, i = i1, i4 )
c-debug;         write(6,'(4(a,2f10.6),a,i3)')
c-debug;     $        '    fzlo,hi=', fzlo, fzhi, '  fxlo,hi=', fxlo, fxhi,
c-debug;     $        '    frlo,hi=', frlo, frhi, '  ftlo,hi=', ftlo, fthi,
c-debug;     $        '  needall', needall
c-debug;      endif
c-debug]
c
      if ( iacc_ferg .gt. 0 ) then
         modt_use = modt_ferg
      else
         modt_use = nt_ferg + 10
      endif
c
      icr = 0
      iar = 0
      icr2 = 0
      iar2 = 0
c					! IF any Z,X-interpolation is needed :
      if ( needall .ne. 0 ) then
c
         icz = 0
         icx = 0
         iaz = 0
         iax = 0
         icz2 = 0
         icx2 = 0
         iaz2 = 0
         iax2 = 0
c
         if ( kf .ne. kf2 .and. lnozlo .and.
     $        kf2 .gt. nz_ferg .and. i1 .lt. modt_ferg )
     $        call quadsto( 1, zlogat, zlog_ferg(nzm2_ferg),
     $                      zlog_ferg(nzm1_ferg), zlog_ferg(nz_ferg) )
c
         i0 = 0
         lacc_xf = .true.
         lacc_t = .false.
c					! for each T-value:
         do it = i1, i4
c
            if ( it .ge. modt_use ) lacc_t = .true.
c
            if ( mf .ne. 1 ) lacc_xf = lacc_t
c
            if ( it .ge. modz0_ferg .and. kf .eq. 1 ) then
               lacc_zf = .true.
            else
               lacc_zf = lacc_t
            endif
c
            if ( kf .ne. kf2 ) then
               if ( .not. lnozlo ) then
                  if ( lacc_zf ) then
                     if ( iaz .eq. 0 ) call quadslsto( 1, zlogat,
     $                    zlog_ferg(kf), zlog_ferg(kg), zlog_ferg(kh) )
                     iaz = 1
                  else if ( icz .eq. 0 ) then
                     call quadsto( 1, zlogat, zlog_ferg(kf),
     $                             zlog_ferg(kg), zlog_ferg(kh) )
                     icz = 1
                  endif
               endif
               if ( kf2 .gt. nz_ferg ) then
                  if ( iaz2 .eq. 0 .and. it .ge. modt_ferg ) then
                     call quadslsto( 3, zlogat, zlog_ferg(nzm1_ferg),
     $                    zlog_ferg(nz_ferg), zlog_ferg(nzp1_ferg) )
                     iaz2 = 1
                  endif
               else if ( kf2 .gt. kh ) then
                  if ( lacc_t ) then
                     if ( iaz2 .eq. 0 ) call quadslsto( 3, zlogat,
     $                    zlog_ferg(kg), zlog_ferg(kh),
     $                    zlog_ferg(kf2) )
                     iaz2 = 1
                  else if ( icz2 .eq. 0 ) then
                     call quadsto( 3, zlogat, zlog_ferg(kg),
     $                             zlog_ferg(kh), zlog_ferg(kf2) )
                     icz2 = 1
                  endif
               endif
            endif
c
            if ( mf .ne. mf2 ) then
               if ( mh .lt. nx_ferg ) then
                  if ( lacc_xf ) then
                     if ( iax .eq. 0 ) call quadslsto( 2, xh,
     $                    x_ferg(mf), x_ferg(mg), x_ferg(mh) )
                     iax = 1
                  else if ( icx .eq. 0 ) then
                     call quadsto( 2, xh, x_ferg(mf),
     $                             x_ferg(mg), x_ferg(mh) )
                     icx = 1
                  endif
               else if ( lacc_xf ) then
                  if ( iax .eq. 0 ) call qchkslsto( 2, xh,
     $                 x_ferg(mf), x_ferg(mg), x_ferg(mh) )
                  iax = 1
               else
                  call qchksto( 2, xh, x_ferg(mf),
     $                          x_ferg(mg), x_ferg(mh) )
                  icx = 1
               endif
               if ( mf2 .gt. mh ) then
                  if ( mf2 .lt. nx_ferg ) then
                     if ( lacc_t ) then
                        if ( iax2 .eq. 0 ) call quadslsto( 4, xh,
     $                       x_ferg(mg), x_ferg(mh), x_ferg(mf2) )
                        iax2 = 1
                     else if ( icx2 .eq. 0 ) then
                        call quadsto( 4, xh, x_ferg(mg),
     $                                x_ferg(mh), x_ferg(mf2) )
                        icx2 = 1
                     endif
                  else if ( lacc_t ) then
                     if ( iax2 .eq. 0 ) call qchkslsto( 4, xh,
     $                    x_ferg(mg), x_ferg(mh), x_ferg(mf2) )
                     iax2 = 1
                  else if ( icx2 .eq. 0 ) then
                     call qchksto( 4, xh, x_ferg(mg),
     $                             x_ferg(mh), x_ferg(mf2) )
                     icx2 = 1
                  endif
               endif
            endif
c
            if ( j1 .gt. 0 .and. frlo .gt. 0.0 ) then
               if ( lacc_t ) then
                  if ( iar .eq. 0 ) call qderslsto( 5, slr,
     $                 rlog_ferg(j1), rlog_ferg(j2), rlog_ferg(j3) )
                  iar = 1
               else if ( icr .eq. 0 ) then
                  call qdersto( 5, slr, rlog_ferg(j1), rlog_ferg(j2),
     $                          rlog_ferg(j3) )
                  icr = 1
               endif
            endif
            if ( j4 .gt. j3 .and. j4 .le. nr_ferg ) then
               if ( lacc_t ) then
                  if ( iar2 .eq. 0 ) call qderslsto( 6, slr,
     $                 rlog_ferg(j2), rlog_ferg(j3), rlog_ferg(j4) )
                  iar2 = 1
               else if ( icr2 .eq. 0 ) then
                  call qdersto( 6, slr, rlog_ferg(j2), rlog_ferg(j3),
     $                          rlog_ferg(j4) )
                  icr2 = 1
               endif
            endif
c
            i0 = i0 + 1
            j0 = max( 0 , 1 - j1 )
c					! for each R-value at that T:
c
            do ir = max( 1 , j1 ), min( nr_ferg , j4 )
c
c				! check whether Z,X-interp is needed at (T,R)
               j0 = j0 + 1
c								  ! if needed:
               if ( needt(i0) .gt. 0 .or. needr(j0) .gt. 0 ) then
c								  ! for each X
                  do ix = mf, mf2
c							      ! that is needed
                     if ( ix .le. mh .or. ix .eq. mf2 ) then
c								! do Z-interp:
                        if ( kf .eq. kf2 ) then
                           h(ix) = flk_ferg(ir,it,kf,ix)
                        else
                           if ( lnozlo ) then
                              if ( kf2 .le. nz_ferg .or.
     $                             it .ge. modt_ferg ) then
                                 h(ix) = flk_ferg(ir,it,kh,ix)
                              else
                                 h(ix) = quadget( 1,
     $                                          flk_ferg(ir,it,kf,ix),
     $                                          flk_ferg(ir,it,kg,ix),
     $                                          flk_ferg(ir,it,kh,ix) )
                              endif
                           else if ( lacc_zf ) then
                              h(ix) = quadslget( 1,
     $                                          flk_ferg(ir,it,kf,ix),
     $                                          flk_ferg(ir,it,kg,ix),
     $                                          flk_ferg(ir,it,kh,ix) )
                           else
                              h(ix) = quadget( 1,
     $                                         flk_ferg(ir,it,kf,ix),
     $                                         flk_ferg(ir,it,kg,ix),
     $                                         flk_ferg(ir,it,kh,ix) )
                           endif
                           if ( kf2 .gt. nz_ferg ) then
                              if ( it .ge. modt_ferg ) then
                                 val = flk_ferg(ir,it,nz_ferg,ix)
     $                                - flk_ferg(ir,it,nzm1_ferg,ix)
                                 vm2 = flk_ferg(ir,it,nzm1_ferg,ix)
     $                                - flk_ferg(ir,it,nzm2_ferg,ix)
                                 if ( abs(val) .le. abs(vm2) ) then
                                    val = flk_ferg(ir,it,nz_ferg,ix)
     $                                   + val
                                 else
                                    val = flk_ferg(ir,it,nz_ferg,ix)
     $                                   + vm2
                                 endif
                                 h(ix) = fzlo * h(ix) + fzhi
     $                                * quadslget( 3,
     $                                    flk_ferg(ir,it,nzm1_ferg,ix),
     $                                    flk_ferg(ir,it,nz_ferg,ix),
     $                                    val )
                              endif
                           else if ( kf2 .gt. kh .and.
     $                             ( ix .ne. nxm1_ferg .or.
     $                             kf2 .le. n2_ferg ) ) then
                              if ( lacc_t ) then
                                 h(ix) = fzlo * h(ix) + fzhi
     $                                * quadslget( 3,
     $                                         flk_ferg(ir,it,kg,ix),
     $                                         flk_ferg(ir,it,kh,ix),
     $                                         flk_ferg(ir,it,kf2,ix) )
                              else
                                 h(ix) = fzlo * h(ix) + fzhi
     $                                * quadget( 3,
     $                                         flk_ferg(ir,it,kg,ix),
     $                                         flk_ferg(ir,it,kh,ix),
     $                                         flk_ferg(ir,it,kf2,ix) )
                                 icz2 = 1
                              endif
                           endif
                        endif
c-debug[
c-debug;                        if ( i_debug_ferg .gt. 8 ) write(6,
c-debug;     $                       '(3(a,i3),a,f11.6,a,4(i3,":",f11.6))')
c-debug;     $                       '          it=', it, ' ir=', ir,
c-debug;     $                       ' ix=', ix, ' h(ix)=', h(ix), ' <--Z',
c-debug;     $                       ( i, flk_ferg(ir,it,i,ix),
c-debug;     $                       i = kf, min(kf2,nz_ferg) )
c-debug]
c
                     endif
c								! end of X-loop
                  enddo
c								! do X-interp:
                  if ( mf .eq. mf2 ) then
                     flk_ferg(ir,it,nzp_sto,nxm1_ferg) = h(mf)
                  else
                     if ( mh .lt. nx_ferg ) then
                        if ( lacc_xf ) then
                           val = quadslget( 2, h(mf), h(mg), h(mh) )
                        else
                           val = quadget( 2, h(mf), h(mg), h(mh) )
                        endif
                     else if ( lacc_xf ) then
                        val = qchkslget( 2, h(mf), h(mg), h(mh) )
                     else
                        val = qchkget( 2, h(mf), h(mg), h(mh) )
                     endif
                     if ( mf2 .gt. mh ) then
                        if ( mf2 .lt. nx_ferg ) then
                           if ( lacc_t ) then
                              val = fxlo * val + fxhi * quadslget( 4,
     $                             h(mg), h(mh), h(mf2) )
                           else
                              val = fxlo * val + fxhi
     $                             * quadget( 4, h(mg), h(mh), h(mf2) )
                           endif
                        else if ( lacc_t ) then
                           val = fxlo * val + fxhi
     $                          * qchkslget( 4, h(mg), h(mh), h(mf2) )
                        else
                           val = fxlo * val + fxhi
     $                          * qchkget( 4, h(mg), h(mh), h(mf2) )
                        endif
                     endif
                     flk_ferg(ir,it,nzp_sto,nxm1_ferg) = val
                  endif
c-debug[
c-debug;                  if ( i_debug_ferg .gt. 7 ) then
c-debug;                     if ( mf2 .gt. mh + 1 ) then
c-debug;                        write(6,
c-debug;     $                       '(2(a,i3),a,f11.6,a,3(i3,":",f11.6),$)')
c-debug;     $                       '        it=', it, ' ir=', ir,
c-debug;     $                       '  flk_ferg(ir,it,nzp_sto,nxm1_ferg)=',
c-debug;     $                       flk_ferg(ir,it,nzp_sto,nxm1_ferg),
c-debug;     $                       ' <--X', ( i, h(i), i = mf, mh )
c-debug;                        write(6,'(i3,":",f11.6)') mf2, h(mf2)
c-debug;                     else
c-debug;                        write(6,
c-debug;     $                       '(2(a,i3),a,f11.6,a,4(i3,":",f11.6))')
c-debug;     $                       '        it=', it, ' ir=', ir,
c-debug;     $                       '  flk_ferg(ir,it,nzp_sto,nxm1_ferg)=',
c-debug;     $                       flk_ferg(ir,it,nzp_sto,nxm1_ferg),
c-debug;     $                       ' <--X', ( i, h(i), i = mf, mf2 )
c-debug;                     endif
c-debug;                  endif
c-debug]
c
               endif
c								! end of R-loop
            enddo
c					! do R-interp, with RHO-derivatives
            if ( frlo .gt. 0.0 ) then
               if ( j1 .le. 0 ) then
                  dg(i0) = ( flk_ferg(2,it,nzp_sto,nxm1_ferg)
     $                 - flk_ferg(1,it,nzp_sto,nxm1_ferg) )
     $                 * drinv_ferg(2)
                  g(i0) = ( slr - rlog_ferg(1) ) * dg(i0)
     $                 + flk_ferg(1,it,nzp_sto,nxm1_ferg)
               else if ( lacc_t ) then
                  call qderslget( 5, flk_ferg(j1,it,nzp_sto,nxm1_ferg),
     $                            flk_ferg(j2,it,nzp_sto,nxm1_ferg),
     $                            flk_ferg(j3,it,nzp_sto,nxm1_ferg),
     $                            g(i0), dg(i0) )
               else
                  call qderget( 5, flk_ferg(j1,it,nzp_sto,nxm1_ferg),
     $                          flk_ferg(j2,it,nzp_sto,nxm1_ferg),
     $                          flk_ferg(j3,it,nzp_sto,nxm1_ferg),
     $                          g(i0), dg(i0) )
               endif
            endif
            if ( j4 .gt. j3 ) then
               if ( j4 .gt. nr_ferg ) then
                  dkap = ( flk_ferg(nr_ferg,it,nzp_sto,nxm1_ferg)
     $                 - flk_ferg(nrm1_ferg,it,nzp_sto,nxm1_ferg) )
     $                 * drinv_ferg(nr_ferg)
                  val = ( slr - rlog_ferg(nr_ferg) ) * dkap
     $              + flk_ferg(nr_ferg,it,nzp_sto,nxm1_ferg)
               else if ( lacc_t ) then
                  call qderslget( 6, flk_ferg(j2,it,nzp_sto,nxm1_ferg),
     $                            flk_ferg(j3,it,nzp_sto,nxm1_ferg),
     $                            flk_ferg(j4,it,nzp_sto,nxm1_ferg),
     $                            val, dkap )
               else
                  call qderget( 6, flk_ferg(j2,it,nzp_sto,nxm1_ferg),
     $                          flk_ferg(j3,it,nzp_sto,nxm1_ferg),
     $                          flk_ferg(j4,it,nzp_sto,nxm1_ferg),
     $                          val, dkap )
               endif
               if ( frlo .gt. 0.0 ) then
                  dg(i0) = frlo * dg(i0) + frhi * dkap
     $                 + drinv_ferg(j3) * ( val - g(i0) )
                  g(i0) = frlo * g(i0) + frhi * val
               else
                  dg(i0) = dkap
                  g(i0) = val
               endif
            endif
c-debug[
c-debug;            if ( i_debug_ferg .gt. 6 )
c-debug;     $           write(6,'(a,i3,2(a,i1,a,f11.6),a,4(i4,":",f11.6))')
c-debug;     $           '      it=', it, ' g(', i0,')=', g(i0),
c-debug;     $           ' dg(', i0,')=', dg(i0), ' <--R',
c-debug;     $           ( i, flk_ferg(i,it,nzp_sto,nxm1_ferg),
c-debug;     $           i = max(1,j1), min(nr_ferg,j4) )
c-debug]
c								! end of T-loop
         enddo
c					! do T-interp, with T-deriv at const R
         if ( i2 .ge. modt_use ) then
            call qderslsto( 7, slt, t6log_ferg(i1),
     $                      t6log_ferg(i2), t6log_ferg(i3) )
            call qderslget( 7, g(1), g(2), g(3), flka, dlkatr )
            dlkaro = quadslget( 7, dg(1), dg(2), dg(3) )
         else
            call qdersto( 7, slt, t6log_ferg(i1),
     $                    t6log_ferg(i2), t6log_ferg(i3) )
            call qderget( 7, g(1), g(2), g(3), flka, dlkatr )
            dlkaro = quadget( 7, dg(1), dg(2), dg(3) )
         endif
         if ( i4 .gt. i3 ) then
            if ( i3 .ge. modt_use ) then
               call qderslsto( 8, slt, t6log_ferg(i2),
     $                         t6log_ferg(i3), t6log_ferg(i4) )
               call qderslget( 8, g(2), g(3), g(4), val, dkap )
               dlkaro = ftlo * dlkaro + fthi
     $              * quadslget( 8, dg(2), dg(3), dg(4) )
            else
               call qdersto( 8, slt, t6log_ferg(i2),
     $                       t6log_ferg(i3), t6log_ferg(i4) )
               call qderget( 8, g(2), g(3), g(4), val, dkap )
               dlkaro = ftlo * dlkaro + fthi
     $              * quadget( 8, dg(2), dg(3), dg(4) )
            endif
            dlkatr = ftlo * dlkatr + fthi * dkap
     $           + dt6inv_ferg(i3) * ( val - flka )
            flka = ftlo * flka + fthi * val
         endif
c-debug[
c-debug;         if ( i_debug_ferg .gt. 5 ) then
c-debug;            write(6,'(2(a,f11.6),a,4(i4,":",f11.6))')
c-debug;     $           '    flka=', flka, ' dlkatr=', dlkatr, ' <--T',
c-debug;     $           ( i, g(i), i = 1, i4 - i1 + 1 )
c-debug;            write(6,'(a,f11.6,a,4(i4,":",f11.6))')
c-debug;     $           '    dlkaro=', dlkaro, ' <--T',
c-debug;     $           ( i, dg(i), i = 1, i4 - i1 + 1 )
c-debug;         endif
c-debug]
c		! ELSE: if no Z,X-interpolation is needed (use stored values) :
      else
c					! do R-interp (same as further above)
         i0 = 0
         lacc_t = .false.
c
         do it = i1, i4
c
            i0 = i0 + 1
            if ( it .ge. modt_use ) lacc_t = .true.
c
            if ( frlo .gt. 0.0 ) then
               if ( j1 .le. 0 ) then
                  dg(i0) = ( flk_ferg(2,it,nzp_sto,nxm1_ferg)
     $                 - flk_ferg(1,it,nzp_sto,nxm1_ferg) )
     $                 * drinv_ferg(2)
                  g(i0) = ( slr - rlog_ferg(1) ) * dg(i0)
     $                 + flk_ferg(1,it,nzp_sto,nxm1_ferg)
               else if ( lacc_t ) then
                  if ( iar .eq. 0 ) call qderslsto( 5, slr,
     $                 rlog_ferg(j1), rlog_ferg(j2), rlog_ferg(j3) )
                  call qderslget( 5, flk_ferg(j1,it,nzp_sto,nxm1_ferg),
     $                            flk_ferg(j2,it,nzp_sto,nxm1_ferg),
     $                            flk_ferg(j3,it,nzp_sto,nxm1_ferg),
     $                            g(i0), dg(i0) )
                  iar = 1
               else
                  if ( icr .eq. 0 ) call qdersto( 5, slr,
     $                 rlog_ferg(j1), rlog_ferg(j2), rlog_ferg(j3) )
                  call qderget( 5, flk_ferg(j1,it,nzp_sto,nxm1_ferg),
     $                          flk_ferg(j2,it,nzp_sto,nxm1_ferg),
     $                          flk_ferg(j3,it,nzp_sto,nxm1_ferg),
     $                          g(i0), dg(i0) )
                  icr = 1
               endif
            endif
            if ( j4 .gt. j3 ) then
               if ( j4 .gt. nr_ferg ) then
                  dkap = ( flk_ferg(nr_ferg,it,nzp_sto,nxm1_ferg)
     $                 - flk_ferg(nrm1_ferg,it,nzp_sto,nxm1_ferg) )
     $                 * drinv_ferg(nr_ferg)
                  val = ( slr - rlog_ferg(nr_ferg) ) * dkap
     $              + flk_ferg(nr_ferg,it,nzp_sto,nxm1_ferg)
               else if ( lacc_t ) then
                  if ( iar2 .eq. 0 ) call qderslsto( 6, slr,
     $                 rlog_ferg(j2), rlog_ferg(j3), rlog_ferg(j4) )
                  call qderslget( 6, flk_ferg(j2,it,nzp_sto,nxm1_ferg),
     $                            flk_ferg(j3,it,nzp_sto,nxm1_ferg),
     $                            flk_ferg(j4,it,nzp_sto,nxm1_ferg),
     $                            val, dkap )
                  iar2 = 1
               else
                  if ( icr2 .eq. 0 ) call qdersto( 6, slr,
     $                 rlog_ferg(j2), rlog_ferg(j3), rlog_ferg(j4) )
                  call qderget( 6, flk_ferg(j2,it,nzp_sto,nxm1_ferg),
     $                          flk_ferg(j3,it,nzp_sto,nxm1_ferg),
     $                          flk_ferg(j4,it,nzp_sto,nxm1_ferg),
     $                          val, dkap )
                  icr2 = 1
               endif
               if ( frlo .gt. 0.0 ) then
                  dg(i0) = frlo * dg(i0) + frhi * dkap
     $                 + drinv_ferg(j3) * ( val - g(i0) )
                  g(i0) = frlo * g(i0) + frhi * val
               else
                  dg(i0) = dkap
                  g(i0) = val
               endif
            endif
c-debug[
c-debug;            if ( i_debug_ferg .gt. 6 )
c-debug;     $           write(6,'(a,i3,2(a,i1,a,f11.6),a,4(i3,":",f11.6))')
c-debug;     $           '      ----it=', it, ' g(', i0,')=', g(i0),
c-debug;     $           ' dg(', i0,')=', dg(i0), ' <--R',
c-debug;     $           ( i, flk_ferg(i,it,nzp_sto,nxm1_ferg),
c-debug;     $           i = max( 1 , j1 ), min( nr_ferg , j4 ) )
c-debug]
c
         enddo
c					! do T-interp, with T-deriv at const R
         if ( i2 .ge. modt_use ) then
            call qderslsto( 7, slt, t6log_ferg(i1),
     $                      t6log_ferg(i2), t6log_ferg(i3) )
            call qderslget( 7, g(1), g(2), g(3), flka, dlkatr )
            dlkaro = quadslget( 7, dg(1), dg(2), dg(3) )
         else
            call qdersto( 7, slt, t6log_ferg(i1),
     $                    t6log_ferg(i2), t6log_ferg(i3) )
            call qderget( 7, g(1), g(2), g(3), flka, dlkatr )
            dlkaro = quadget( 7, dg(1), dg(2), dg(3) )
         endif
         if ( i4 .gt. i3 ) then
            if ( i3 .ge. modt_use ) then
               call qderslsto( 8, slt, t6log_ferg(i2),
     $                         t6log_ferg(i3), t6log_ferg(i4) )
               call qderslget( 8, g(2), g(3), g(4), val, dkap )
               dlkaro = ftlo * dlkaro + fthi
     $              * quadslget( 8, dg(2), dg(3), dg(4) )
            else
               call qdersto( 8, slt, t6log_ferg(i2),
     $                       t6log_ferg(i3), t6log_ferg(i4) )
               call qderget( 8, g(2), g(3), g(4), val, dkap )
               dlkaro = ftlo * dlkaro + fthi
     $              * quadget( 8, dg(2), dg(3), dg(4) )
            endif
            dlkatr = ftlo * dlkatr + fthi * dkap
     $           + dt6inv_ferg(i3) * ( val - flka )
            flka = ftlo * flka + fthi * val
         endif
c-debug[
c-debug;         if ( i_debug_ferg .gt. 5 ) then
c-debug;            write(6,'(2(a,f11.6),a,4(i3,":",f11.6))')
c-debug;     $           '    flka=', flka, ' dlkatr=', dlkatr, ' <--T',
c-debug;     $           ( i, g(i), i = 1, i4 - i1 + 1 )
c-debug;            write(6,'(a,f11.6,a,4(i3,":",f11.6))')
c-debug;     $           '      dlkaro=', dlkaro, ' <--T',
c-debug;     $           ( i, dg(i), i = 1, i4 - i1 + 1 )
c-debug;         endif
c-debug]
c
      endif
c					! get T-derivative at constant density
      dlkat = dlkatr - 3.0 * dlkaro
c					! restore possibly-changed max X-value
      x_ferg(nx_ferg) = 1.0
c				 ! if any new Z,X-interp values were computed:
      if ( needall .ne. 0 ) then
c				 ! store the available (T,R) range for these
         i1p_ferg = i1
         i4p_ferg = i4
         j1p_ferg = max( 1 , j1 )
         j4p_ferg = min( nr_ferg , j4 )
c					! if ALL are new, store Z and X values
         if ( needall .gt. 0 ) then
            zlogp_ferg = zlogat
            xp_ferg = xh
         endif
c
      endif
c-debug[
c-debug;      if ( i_debug_ferg .gt. 1 ) write(6,'(5(a,f11.6))')
c-debug;     $     '  END kapferg: RETURN flka=', flka, ' dlkatr=', dlkatr,
c-debug;     $     ' dlkaro=', dlkaro, ' dlkat=', dlkat, ' fkaedge=', fkaedge
c-debug]
c
      return
      end
c
c******************************************************************************
c
      subroutine cacheferg( ksto, xh, xzco )
c     --------------------------------------
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /mat_alex_ferg/ flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg)
      save /mat_alex_ferg/
c
      common /opac_ferg/ zlog_ferg(nzp1_ferg), xlog_ferg(nx_ferg),
     $     dzinvlog_ferg(nz_ferg), dzinv_ferg(nz_ferg),
     $     dxinvlog_ferg(nx_ferg), dxinv_ferg(nx_ferg),
     $     t6log_ferg(nt_ferg), rlog_ferg(nr_ferg),
     $     dt6inv_ferg(nt_ferg), drinv_ferg(nr_ferg),
     $     modt_ferg, modz0_ferg, ntuferg
      save /opac_ferg/
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_prev_ferg/ zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $     zlp2_ferg, xp2_ferg, i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
      save /c_prev_ferg/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      parameter ( nzm1_ferg=nz_ferg-1, nzm2_ferg=nz_ferg-2 )
c
      logical lacc_t, lacc_zf, lacc_xf, lnozlo
c
      dimension h(nx_ferg)
c					! have Ferguson et al. 2005 opacities?
      if ( kavail_alex .le. 1 ) return
c
      zpxc = min( 1.0 , max( xzco , 0.0 ) )
      y = 1.0 - xh - zpxc
c							! check composition
      if ( min( xh , xzco , y ) .le. -1.e-6 .or.
     $     zpxc .gt. 0.12 ) return
c
      fzlo = 1.0
c					! these just prevent compiler warnings:
      fzhi = 0.0
      fxlo = 1.0
      fxhi = 0.0
c-noXlog;      xlogat = xh
      zlogat = zpxc
c						! index to store values at
      nzp_sto = max( 1 , min( 2, ksto ) )
c							! get X-indices
      if ( xh .lt. 1.e-6 ) then
c
         mf = 1
         mf2 = 1
         mg = 1
         mh = 1
c
      else if ( y .lt. 1.e-6 ) then
c
         mf = nx_ferg
         mf2 = nx_ferg
         mg = nx_ferg
         mh = nx_ferg
c
      else
c
         if ( zpxc .ge. z_ferg(nz_ferg) ) then
            ixhi = nxm2_ferg
         else if ( zpxc .ge. z_ferg(n2_ferg) ) then
            ixhi = nxm1_ferg
         else
            ixhi = nx_ferg
         endif
c
         ilo = 2
         ihi = ixhi
         do while ( ihi - ilo .gt. 1 )
            iat = ( ihi + ilo ) / 2
            if ( xh .ge. x_ferg(iat) ) then
               ilo = iat
            else
               ihi = iat
            endif
         enddo
c
         if ( abs( x_ferg(ilo) - xh ) .lt. 1.e-6 ) then
            mf = ilo
            mf2 = ilo
            mg = ilo
            mh = ilo
         else if ( abs( x_ferg(ihi) - xh ) .lt. 1.e-6 ) then
            mf = ihi
            mf2 = ihi
            mg = ihi
            mh = ihi
         else
            x_ferg(nx_ferg) = 1.0 - zpxc
            if ( xh .gt. x_ferg(ilo) ) then
               mf2 = min( ihi + 1 , ixhi )
            else
               mf2 = ihi
            endif
            if ( mf2 .eq. ihi .or. xh .lt. x_ferg(ihi) ) then
               mf = ilo - 1
               mg = ilo
               mh = ihi
            else
               mf = ilo
               mg = ihi
               mh = mf2
            endif
         endif
c
         if ( ixhi .lt. nx_ferg ) then
            if ( mf2 .eq. ixhi ) mf2 = nx_ferg
            if ( mh .eq. ixhi ) mh = nx_ferg
            if ( mg .eq. ixhi ) mg = nx_ferg
            if ( mf .eq. ixhi ) mf = nx_ferg
         endif
c
c-noXlog;         if ( mf .le. 2 .and. mf2 .gt. mf )
c-noXlog;     $        xlogat = log10( xh + xdel_ferg )
c
         if ( mf2 .gt. mh ) then
c-noXlog;            if ( mg .eq. 2 ) then
c-noXlog;               fxlo = max( 0.0 , min( 1.0 ,
c-noXlog;     $              ( xlog_ferg(mh) - xlogat ) * dxinvlog_ferg(mh) ) )
c-noXlog;            else
            fxlo = max( 0.0 , min( 1.0 ,
     $           ( x_ferg(mh) - xh ) * dxinv_ferg(mh) ) )
c-noXlog;            endif
            fxhi = 1.0 - fxlo
         endif
c
      endif
c							! get Z-indices
      if ( zpxc .lt. z0_ferg ) then
c
         kf = 1
         kg = 1
         kh = 1
         kf2 = 1
         zlogat = zlog_ferg(1)
c
      else
c
         ilo = 2
         ihi = nz_ferg
         do while ( ihi - ilo .gt. 1 )
            iat = ( ihi + ilo ) / 2
            if ( zpxc .ge. z_ferg(iat) ) then
               ilo = iat
            else
               ihi = iat
            endif
         enddo
c
         if ( abs( z_ferg(ilo) - zpxc ) .lt. 1.e-6 * zpxc ) then
            kf = ilo
            kg = ilo
            kh = ilo
            kf2 = ilo
            zlogat = zlog_ferg(ilo)
         else if ( abs( z_ferg(ihi) - zpxc ) .lt. 1.e-6 * zpxc ) then
            kf = ihi
            kg = ihi
            kh = ihi
            kf2 = ihi
            zlogat = zlog_ferg(ihi)
         else
            kf = ilo - 1
            kg = ilo
            kh = ihi
            zlogat = log10( zpxc + zdel_ferg )
            if ( ihi .ge. nz_ferg .or. zpxc .le. z_ferg(ilo) ) then
               kf2 = ihi
               if ( iacc_ferg .gt. 0 .and. ihi .eq. nz_ferg ) then
                  kf2 = nzp1_ferg
                  fzlo = max( 0.0 , min( 1.0 ,
     $                 ( zlog_ferg(nz_ferg) - zlogat )
     $                 * dzinvlog_ferg(nz_ferg) ) )
                  fzhi = 1.0 - fzlo
               endif
            else
               kf2 = ihi + 1
               fzlo = max( 0.0 , min( 1.0 ,
     $              ( zlog_ferg(kh) - zlogat ) * dzinvlog_ferg(kh) ) )
               fzhi = 1.0 - fzlo
            endif
         endif
c
      endif
c
      if ( fzlo .le. 0.0 ) then
         lnozlo = .true.
      else
         lnozlo = .false.
      endif
c
      if ( iacc_ferg .gt. 0 ) then
         modt_use = modt_ferg
      else
         modt_use = nt_ferg + 10
      endif
c
      if ( kf .ne. kf2 ) then
         if ( lnozlo ) then
            call quadsto( 1, zlogat, zlog_ferg(nzm2_ferg),
     $                    zlog_ferg(nzm1_ferg), zlog_ferg(nz_ferg) )
         else
            if ( ( modt_use .gt. 0 .and. ntuferg .ge. modt_use ) .or.
     $           ( ntuferg .ge. modz0_ferg .and. kf .eq. 1 ) )
     $           call quadslsto( 1, zlogat, zlog_ferg(kf),
     $                           zlog_ferg(kg), zlog_ferg(kh) )
            call quadsto( 1, zlogat, zlog_ferg(kf),
     $                    zlog_ferg(kg), zlog_ferg(kh) )
         endif
         if ( kf2 .gt. nz_ferg ) then
            if ( ntuferg .ge. modt_ferg )
     $           call quadslsto( 3, zlogat, zlog_ferg(nzm1_ferg),
     $                       zlog_ferg(nz_ferg), zlog_ferg(nzp1_ferg) )
         else if ( kf2 .gt. kh ) then
            if ( modt_use .gt. 0 .and. ntuferg .ge. modt_use )
     $           call quadslsto( 3, zlogat, zlog_ferg(kg),
     $                           zlog_ferg(kh), zlog_ferg(kf2) )
            call quadsto( 3, zlogat, zlog_ferg(kg),
     $                    zlog_ferg(kh), zlog_ferg(kf2) )
         endif
      endif
c
      if ( mf .ne. mf2 ) then
         if ( mh .lt. nx_ferg ) then
            if ( mf .eq. 1 .or. ( modt_use .gt. 0 .and.
     $           ntuferg .ge. modt_use ) ) call quadslsto( 2, xh,
     $                             x_ferg(mf), x_ferg(mg), x_ferg(mh) )
            call quadsto( 2, xh, x_ferg(mf), x_ferg(mg), x_ferg(mh) )
         else
            if ( mf .eq. 1 .or. ( modt_use .gt. 0 .and.
     $           ntuferg .ge. modt_use ) ) call qchkslsto( 2, xh,
     $                             x_ferg(mf), x_ferg(mg), x_ferg(mh) )
            if ( mf .ne. 1 .and. modt_use .ne. 1 ) call qchksto( 2, xh,
     $                             x_ferg(mf), x_ferg(mg), x_ferg(mh) )
         endif
         if ( mf2 .gt. mh ) then
            if ( mf2 .lt. nx_ferg ) then
               if ( modt_use .gt. 0 .and. ntuferg .ge. modt_use )
     $              call quadslsto( 4, xh, x_ferg(mg),
     $                              x_ferg(mh), x_ferg(mf2) )
               call quadsto( 4, xh, x_ferg(mg),
     $                       x_ferg(mh), x_ferg(mf2) )
            else
               if ( modt_use .gt. 0 .and. ntuferg .ge. modt_use )
     $              call qchkslsto( 4, xh, x_ferg(mg),
     $                              x_ferg(mh), x_ferg(mf2) )
               if ( modt_use .ne. 1 ) call qchksto( 4, xh, x_ferg(mg),
     $                                        x_ferg(mh), x_ferg(mf2) )
            endif
         endif
      endif
c
      lacc_t = .false.
      lacc_xf = .true.
c					! for each T-value:
      do it = 1, ntuferg
c
         if ( it .eq. modt_use ) lacc_t = .true.
c
         if ( mf .ne. 1 ) lacc_xf = lacc_t
c
         if ( it .ge. modz0_ferg .and. kf .eq. 1 ) then
            lacc_zf = .true.
         else
            lacc_zf = lacc_t
         endif
c					! for each R-value at that T:
         do ir = 1, nr_ferg
c								  ! for each X
            do ix = mf, mf2
c							      ! that is needed
               if ( ix .le. mh .or. ix .eq. mf2 ) then
c								! do Z-interp:
                  if ( kf .eq. kf2 ) then
                     h(ix) = flk_ferg(ir,it,kf,ix)
                  else
                     if ( lnozlo ) then
                        if ( kf2 .le. nz_ferg .or.
     $                       it .ge. modt_ferg ) then
                           h(ix) = flk_ferg(ir,it,kh,ix)
                        else
                           h(ix) = quadget( 1, flk_ferg(ir,it,kf,ix),
     $                                      flk_ferg(ir,it,kg,ix),
     $                                      flk_ferg(ir,it,kh,ix) )
                        endif
                     else if ( lacc_zf ) then
                        h(ix) = quadslget( 1, flk_ferg(ir,it,kf,ix),
     $                                     flk_ferg(ir,it,kg,ix),
     $                                     flk_ferg(ir,it,kh,ix) )
                     else
                        h(ix) = quadget( 1, flk_ferg(ir,it,kf,ix),
     $                                   flk_ferg(ir,it,kg,ix),
     $                                   flk_ferg(ir,it,kh,ix) )
                     endif
                     if ( kf2 .gt. nz_ferg ) then
                        if ( it .ge. modt_ferg ) then
                           val = flk_ferg(ir,it,nz_ferg,ix)
     $                          - flk_ferg(ir,it,nzm1_ferg,ix)
                           vm2 = flk_ferg(ir,it,nzm1_ferg,ix)
     $                          - flk_ferg(ir,it,nzm2_ferg,ix)
                           if ( abs(val) .le. abs(vm2) ) then
                              val = flk_ferg(ir,it,nz_ferg,ix) + val
                           else
                              val = flk_ferg(ir,it,nz_ferg,ix) + vm2
                           endif
                           h(ix) = fzlo * h(ix) + fzhi
     $                          * quadslget( 3,
     $                                    flk_ferg(ir,it,nzm1_ferg,ix),
     $                                    flk_ferg(ir,it,nz_ferg,ix),
     $                                    val )
                        endif
                     else if ( kf2 .gt. kh .and.
     $                       ( ix .ne. nxm1_ferg .or.
     $                       kf2 .le. n2_ferg ) ) then
                        if ( lacc_t ) then
                           h(ix) = fzlo * h(ix) + fzhi
     $                          * quadslget( 3, flk_ferg(ir,it,kg,ix),
     $                                       flk_ferg(ir,it,kh,ix),
     $                                       flk_ferg(ir,it,kf2,ix) )
                        else
                           h(ix) = fzlo * h(ix) + fzhi
     $                          * quadget( 3, flk_ferg(ir,it,kg,ix),
     $                                     flk_ferg(ir,it,kh,ix),
     $                                     flk_ferg(ir,it,kf2,ix) )
                        endif
                     endif
                  endif
c
               endif
c								! end of X-loop
            enddo
c								! do X-interp:
            if ( mf .eq. mf2 ) then
               flk_ferg(ir,it,nzp_sto,nxm1_ferg) = h(mf)
            else
               if ( mh .lt. nx_ferg ) then
                  if ( lacc_xf ) then
                     val = quadslget( 2, h(mf), h(mg), h(mh) )
                  else
                     val = quadget( 2, h(mf), h(mg), h(mh) )
                  endif
               else if ( lacc_xf ) then
                  val = qchkslget( 2, h(mf), h(mg), h(mh) )
               else
                  val = qchkget( 2, h(mf), h(mg), h(mh) )
               endif
               if ( mf2 .gt. mh ) then
                  if ( mf2 .lt. nx_ferg ) then
                     if ( lacc_t ) then
                        val = fxlo * val + fxhi
     $                       * quadslget( 4, h(mg), h(mh), h(mf2) )
                     else
                        val = fxlo * val + fxhi
     $                       * quadget( 4, h(mg), h(mh), h(mf2) )
                     endif
                  else if ( lacc_t ) then
                     val = fxlo * val + fxhi
     $                    * qchkslget( 4, h(mg), h(mh), h(mf2) )
                  else
                     val = fxlo * val + fxhi
     $                    * qchkget( 4, h(mg), h(mh), h(mf2) )
                  endif
               endif
               flk_ferg(ir,it,nzp_sto,nxm1_ferg) = val
            endif
c								! end of R-loop
         enddo
c								! end of T-loop
      enddo
c
      if ( ksto .le. 1 ) then
         zlp1_ferg = zlogat
         xp1_ferg = xh
      else
         zlp2_ferg = zlogat
         xp2_ferg = xh
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine kap_mol( slt, slr, xh, z, exC, exO,
     $                    flka, dlkatr, dlkaro, dlkat, fkaedge )
c     ==========================================================
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_edge_alex/ fkaedgelo, fkaedgehi, fzkaedge
      save /c_edge_alex/
c
      if ( kavail_alex .ne. 1 ) then
c
         call kapferg( slt, slr, xh, z, exC, exO,
     $                 flka, dlkatr, dlkaro, dlkat, fkaedge )
c
      else
c
         flt = slt + 6.
         flrho = slr + 3. * slt
c
         call kapalex( flt, flrho, xh, z + exC + exO,
     $                 flka, dlkat, dlkaro, fkaedge )
c
         dlkatr = dlkat + 3.0 * dlkaro
c
         if ( kuse_alex .ge. 4 ) then
            tmp = max( 0.0 , 1.0 - ( abs(exC) + abs(exO) ) * 5.0
     $           / max( z , 0.0001 , z + exC + exO ) )
            fzkaedge = fzkaedge * tmp
            fkaedge = fkaedge * tmp
         endif
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine kapalex(flt,flro,x,xzco,flka,dlkat,dlkaro,fkaedge)
c     =============================================================
c
c Given  flt = log T , flro = log rho , x = X , xzco = Z + exCO  (where exCO is
c excess-CO mass fraction above what is contained in Z), the subroutine KAPALEX
c returns flka = log10 Kappa(Alexander1994) , dlkat = (dLogKappa/dLogT)_rho ,
c dlkaro = (dLogKappa/dLogRHO)_T , and the edge-of-matrix indicator variable
c  fkaedge = 1.0  inside the matrix: 3.0 < logT < 4.1 , -12 < log rho < -6 ,
c                                     and  either Z+Xc < 0.1 or X = 0.0 .
c  fkaedge = 0.0  for more than one grid-spacing of extrapolation beyond the
c                 edge of the matrix; (in this case, no opacities are computed)
c  1 > fkaedge > 0  gives extent of extrapolation (from 1 = no extrap, to
c                   very small value = extrap by nearly one grid spacing).
c
      parameter ( small_1m6=1.e-6, small_m1m6=-1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /mat_alex_ferg/ flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg)
      save /mat_alex_ferg/
      dimension flk_alex(nrlo_alex:nr_alex,nt_alex,nzp1_alex,nx_alex)
      equivalence (flk_alex(nrlo_alex,1,1,1),flk_ferg(1,1,1,1))
c
      common /opac_alex/ zlog_alex(nzp1_alex),xlog_alex(nx_alex),
     $     dzinvlog_alex(nzp1_alex),dxinvlog_alex(nx_alex)
      save /opac_alex/
c
      common /c_ini_alex/ z_alex(nzp1_alex),x_alex(nx_alex),
     $     flt_alex(nt_alex),flro_alex(nrlo_alex:nr_alex)
      save /c_ini_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_edge_alex/ fkaedgelo, fkaedgehi, fzkaedge
      save /c_edge_alex/
c
      common/d_opal_z/ dkap
      save /d_opal_z/
c
      parameter ( badlogkval=1.e+35 )
c===
      flka = badlogkval
      dlkat = 0.0
      dlkaro = 0.0
      fkaedge = 0.0
      fkaedgelo = 1.0
      fkaedgehi = 1.0
      fzkaedge = 1.0
c					! must have Alexander 1994 opacities
      if ( kavail_alex .ne. 1 ) return
c					  ! zpxc=Z+exC+exO is interp. variable
      zpxc = min( 1.0 , max( xzco , 0.0 ) )
c							! check composition
      if ( min(x,xzco,1.-x-zpxc) .le. small_m1m6 ) then
         write(6,10) x, 1.-x-zpxc, xzco
 10      format(' '/' KAPALEX Error: bad X=',1p,e13.6,
     $        ' Y=1-X-Z-CO=',e13.6,' Z+CO=',e13.6)
         stop ' STOP - KAPALEX: bad { X , Z + exCO } composition . '
      endif
c								! check bounds
      fkaedgelo = max( 0. , 1. + min( 0. ,
     $     (flt-flt_alex(1))*dtinv_alex ,
     $     (flro-flro_alex(nrlo_alex))*droinv_alex ) )
      fkaedgehi = max( 0. , 1. + min( 0. ,
     $     (flt_alex(nt_alex)-flt)*dtinv_alex ,
     $     (flro_alex(nr_alex)-flro)*droinv_alex ) )
c
      izchk_alex = iabs( kuse_alex )
c
      if ( izchk_alex .ge. 3 ) then
         fzkaedge = max( 0.0 , min( 1.0 , ( 0.05 - zpxc ) * 50.0 ,
     $        zpxc * 2.0 / z_alex(2) - 1.0 ) )
         fkaedge = fzkaedge * min( fkaedgelo, fkaedgehi )
      else
         fkaedge = min( fkaedgelo, fkaedgehi )
      endif
c
      if ( fkaedge .le. 0.0 ) return
c					! may be needed for X < 0.1:
      xdelminat = xdelmin_alex
c				! these just prevent compiler warnings:
      fxlo = 1.0
      fxhi = 0.0
c							! get X-indices
      if ( x .lt. small_1m6 ) then
c
         mf = 1
         mf2 = 1
         mg = 1
         mh = 1
         ihiz = nzp1_alex
c
      else
c
         ilo = 2
         ihi = nx_alex
         do while ( ihi-ilo .gt. 1 )
            iat = (ihi+ilo)/2
            if ( x .ge. x_alex(iat) ) then
               ilo = iat
            else
               ihi = iat
            endif
         enddo
c
         if ( abs(x_alex(ilo)-x) .lt. small_1m6 ) then
            mf = ilo
            mf2 = ilo
            mg = ilo
            mh = ilo
         else if ( abs(x_alex(ihi)-x) .lt. small_1m6 ) then
            mf = ihi
            mf2 = ihi
            mg = ihi
            mh = ihi
         else
            mf = ilo - 1
            mf2 = ihi
            if ( x .gt. x_alex(ilo) ) mf2 = min(ihi+1,nx_alex)
            mg = ilo
            mh = ihi
            xlogat = log10(x+xdel_alex)
c					! for double-quadratic
            if ( mf2 .gt. mh ) then
               fxlo = max( min(
     $              (xlog_alex(mh)-xlogat)*dxinvlog_alex(mh) ,
     $              1. ) , 0. )
               fxhi = 1.-fxlo
            endif
c					! may be needed for X < 0.1:
            if ( mf .eq. 1 ) then
               if ( flt .gt. 3.6 )
     $              xdelminat = (flt-3.6)*0.002 + xdelmin_alex
            endif
         endif
c			! for X > 0, require Z+Xc < .15, unless X < 0.03
         ihiz = nz_alex
         if ( mf .eq. 1 .and. x .lt. x_alex(2) ) ihiz = nzp1_alex
         if ( izchk_alex .le. 2 .and. zpxc .gt. z_alex(nz_alex) ) then
            fzkaedge = min( 1. , max( 0. ,
     $           1. + ( z_alex(nz_alex) - zpxc ) / zex_alex ) )
            if ( izchk_alex .le. 1 .and. ihiz .eq. nzp1_alex )
     $           fzkaedge = max( fzkaedge , 0. , 1. - x / x_alex(2) )
            fkaedge = max( 0.0 , fkaedge * fzkaedge )
            if ( fkaedge .le. 0. ) return
         endif
c
      endif
c							! get Z-indices
      ihi = ihiz
      ilo = 1
      do while( ihi-ilo .gt. 1 )
         iat = (ihi+ilo)/2
         if ( zpxc .ge. z_alex(iat) ) then
            ilo = iat
         else
            ihi = iat
         endif
      enddo
      if ( abs(z_alex(ilo)-zpxc) .lt. small_1m6 .and.
     $     ( ilo .gt. 1 .or. zpxc .eq. 0. ) ) then
         kf = ilo
         kf2 = ilo
         kg = ilo
         kh = ilo
      else if ( abs(z_alex(ihi)-zpxc) .lt. small_1m6 .and.
     $        ( ihi .le. nz_alex .or. mf2 .eq. 1 ) ) then
         kf = ihi
         kf2 = ihi
         kg = ihi
         kh = ihi
      else if ( ilo .eq. 1 ) then
         kf = 1
         kf2 = 2
         kg = 2
         kh = 2
      else if ( ihiz .eq. nzp1_alex .and.
     $        ihi .ge. nz_alex .and. mf2 .ge. 3 ) then
         kf2 = nzp1_alex
         kh = nz_alex
         kg = kh - 1
         kf = kh - 2
      else
         kf = ilo-1
         kf2 = ihi
         if ( zpxc .gt. z_alex(ilo) ) kf2 = min(ihi+1,ihiz)
         kg = ilo
         kh = ihi
      endif
c								! get T-indices
      i2 = max( 2 , min( ntm1_alex ,
     $     int( ( flt - flt_alex(1) ) * dtinv_alex + 1. ) ) )
      i1 = i2-1
      i3 = i2+1
      if ( flt .gt. flt_alex(i2) .and. i3 .lt. nt_alex ) then
         i4 = i3+1
      else
         i4 = i3
      endif
c								! rho-indices
      j2 = max( nrlop1_alex , min( nrm1_alex , int( ( flro
     $     - flro_alex(nrlo_alex) ) * droinv_alex ) + nrlo_alex ) )
      j1 = j2-1
      j3 = j2+1
      if ( flro .gt. flro_alex(j2) .and. j3 .lt. nr_alex ) then
         j4 = j3+1
      else
         j4 = j3
      endif
c		! first interpolate logKappa in logRHO, logT, and log(X+xdel)
c
      call qderNsto( 1, j4 - j1, flro, flro_alex(j1), flro_alex(j2),
     $               flro_alex(j3), flro_alex(j4) )
c
      call qderNsto( 3, i4 - i1, flt, flt_alex(i1), flt_alex(i2),
     $               flt_alex(i3), flt_alex(i4) )
c
      if ( mf2 .gt. mf ) then
         call quadsto( 5, xlogat, xlog_alex(mf),
     $                 xlog_alex(mg), xlog_alex(mh) )
         if ( mf2 .gt. mh ) call quadsto( 6, xlogat, xlog_alex(mg),
     $                                  xlog_alex(mh), xlog_alex(mf2) )
      endif
c					! loop over metallicities
      do k = kf, kf2
c						! loop over X-values
         do m = mf, mf2
c						    ! Z=1.0 mix is only for X=0
            if ( k .le. nz_alex .or. m .eq. 1 ) then
c							! loop over T-values
               do i = i1, i4
c				! RHO-interp: get logK(T,Z,X), {dK/dRHO}(T,Z,X)
c				! store in flk_alex(24:25,iT,12,6) [empty]
c
                  call qderNget( 1, j4 - j1, flk_alex(j1,i,k,m),
     $                 flk_alex(j2,i,k,m), flk_alex(j3,i,k,m),
     $                 flk_alex(j4,i,k,m),
     $                 flk_alex(nr_alex,i,nzp1_alex,nx_alex),
     $                 flk_alex(nrm1_alex,i,nzp1_alex,nx_alex) )
c						! end loop over T-values
               enddo
c			! T-interp: get logK(Z,X), {dK/dT}(Z,X), {dK/dRHO}(Z,X)
c			! store in flk_alex(kf:kf2,mf:mf2,12,4:6) [kf2 < 13]
c
               call qderNget( 3, i4 - i1,
     $                        flk_alex(nr_alex,i1,nzp1_alex,nx_alex),
     $                        flk_alex(nr_alex,i2,nzp1_alex,nx_alex),
     $                        flk_alex(nr_alex,i3,nzp1_alex,nx_alex),
     $                        flk_alex(nr_alex,i4,nzp1_alex,nx_alex),
     $                        flk_alex(k,m,nzp1_alex,nx_alex),
     $                        flk_alex(k,m,nzp1_alex,nxm1_alex) )
               flk_alex(k,m,nzp1_alex,nxm2_alex) =
     $              quadNget( 3, i4 - i1,
     $                       flk_alex(nrm1_alex,i1,nzp1_alex,nx_alex),
     $                       flk_alex(nrm1_alex,i2,nzp1_alex,nx_alex),
     $                       flk_alex(nrm1_alex,i3,nzp1_alex,nx_alex),
     $                       flk_alex(nrm1_alex,i4,nzp1_alex,nx_alex) )
            endif
c						! end loop over X-values
         enddo
c	    ! X-interpolation, if needed: get logK(Z), {dK/dT}(Z), {dK/dRHO}(Z)
c     ! store in flk_alex(kf:kf2,mf,12,4:6): replaces T-interp case at lowest X
c
         if ( mf2 .gt. mf .and. k .le. nz_alex ) then
            xdelat = xdel_alex
            if ( mf .eq. 1 ) then
               delhi = flk_alex(k,mh,nzp1_alex,nx_alex)
     $              - flk_alex(k,mg,nzp1_alex,nx_alex)
               dello = flk_alex(k,mg,nzp1_alex,nx_alex)
     $              - flk_alex(k,mf,nzp1_alex,nx_alex)
               if ( delhi .lt. dello .and. dello .gt. 0.0 ) then
                  xdelat = max( xdel_alex * abs(delhi/dello)**2 ,
     $                 xdelminat )
                  if ( dello .lt. 0.01 ) xdelat = min(
     $                 ((0.01-dello)*100.)**2 * (xdel_alex-xdelat)
     $                 + xdelat , xdel_alex )
               endif
            endif
            if ( xdelat .ge. xdel_alex ) then
               flk_alex(k,mf,nzp1_alex,nx_alex) = quadget( 5,
     $              flk_alex(k,mf,nzp1_alex,nx_alex),
     $              flk_alex(k,mg,nzp1_alex,nx_alex),
     $              flk_alex(k,mh,nzp1_alex,nx_alex) )
               flk_alex(k,mf,nzp1_alex,nxm1_alex) = quadget( 5,
     $              flk_alex(k,mf,nzp1_alex,nxm1_alex),
     $              flk_alex(k,mg,nzp1_alex,nxm1_alex),
     $              flk_alex(k,mh,nzp1_alex,nxm1_alex) )
               flk_alex(k,mf,nzp1_alex,nxm2_alex) = quadget( 5,
     $              flk_alex(k,mf,nzp1_alex,nxm2_alex),
     $              flk_alex(k,mg,nzp1_alex,nxm2_alex),
     $              flk_alex(k,mh,nzp1_alex,nxm2_alex) )
            else
               flk_alex(k,mf,nzp1_alex,nx_alex) = qzinter(0,9,x,2,
     $              flk_alex(k,mf,nzp1_alex,nx_alex),
     $              flk_alex(k,mg,nzp1_alex,nx_alex),
     $              flk_alex(k,mh,nzp1_alex,nx_alex),0.0,
     $              x_alex(mf),x_alex(mg),x_alex(mh),0.0,xdelat)
               flk_alex(k,mf,nzp1_alex,nxm1_alex) = qzinter(1,9,x,2,
     $              flk_alex(k,mf,nzp1_alex,nxm1_alex),
     $              flk_alex(k,mg,nzp1_alex,nxm1_alex),
     $              flk_alex(k,mh,nzp1_alex,nxm1_alex),0.0,
     $              x_alex(mf),x_alex(mg),x_alex(mh),0.0,xdelat)
               flk_alex(k,mf,nzp1_alex,nxm2_alex) = qzinter(1,9,x,2,
     $              flk_alex(k,mf,nzp1_alex,nxm2_alex),
     $              flk_alex(k,mg,nzp1_alex,nxm2_alex),
     $              flk_alex(k,mh,nzp1_alex,nxm2_alex),0.0,
     $              x_alex(mf),x_alex(mg),x_alex(mh),0.0,xdelat)
            endif
            if ( mf2 .gt. mh ) then
               flk_alex(k,mf,nzp1_alex,nx_alex) =
     $              fxlo * flk_alex(k,mf,nzp1_alex,nx_alex) + fxhi
     $              * quadget( 6, flk_alex(k,mg,nzp1_alex,nx_alex),
     $                         flk_alex(k,mh,nzp1_alex,nx_alex),
     $                         flk_alex(k,mf2,nzp1_alex,nx_alex) )
               flk_alex(k,mf,nzp1_alex,nxm1_alex) =
     $              fxlo * flk_alex(k,mf,nzp1_alex,nxm1_alex) + fxhi
     $              * quadget( 6, flk_alex(k,mg,nzp1_alex,nxm1_alex),
     $                         flk_alex(k,mh,nzp1_alex,nxm1_alex),
     $                         flk_alex(k,mf2,nzp1_alex,nxm1_alex) )
               flk_alex(k,mf,nzp1_alex,nxm2_alex) =
     $              fxlo * flk_alex(k,mf,nzp1_alex,nxm2_alex) + fxhi
     $              * quadget( 6, flk_alex(k,mg,nzp1_alex,nxm2_alex),
     $                         flk_alex(k,mh,nzp1_alex,nxm2_alex),
     $                         flk_alex(k,mf2,nzp1_alex,nxm2_alex) )
            endif
         endif
c					! end loop over metallicities
      enddo
c		! interpolate in Z+exCO, if necessary: get logK, dK/dT, dK/dRHO
c
      if ( kf .eq. kf2 ) then
         flka = flk_alex(kf,mf,nzp1_alex,nx_alex)
         dlkat = flk_alex(kf,mf,nzp1_alex,nxm1_alex)
         dlkaro = flk_alex(kf,mf,nzp1_alex,nxm2_alex)
c						      ! Z < 0.0001: interpolate
c						      !  Kappa linearly in Z+Xc
      else if ( kf2 .eq. 2 ) then
         fzhi = zpxc / z_alex(2)
         fzlo = 1.-fzhi
         fzlo = fzlo * 10.**flk_alex(1,mf,nzp1_alex,nx_alex)
         fzhi = fzhi * 10.**flk_alex(2,mf,nzp1_alex,nx_alex)
         flka = fzlo + fzhi
         dlkat = ( fzlo * flk_alex(1,mf,nzp1_alex,nxm1_alex)
     $        + fzhi * flk_alex(2,mf,nzp1_alex,nxm1_alex) ) / flka
         dlkaro = ( fzlo * flk_alex(1,mf,nzp1_alex,nxm2_alex)
     $        + fzhi * flk_alex(2,mf,nzp1_alex,nxm2_alex) ) / flka
         flka = log10(flka)
c				! else quadratic logKappa in log(Z+Xc+zdel)
      else
         zlogat = log10(zpxc+zdel_alex)
         call quadsto( 1, zlogat, zlog_alex(kf), zlog_alex(kg),
     $                 zlog_alex(kh) )
         flka = quadget( 1, flk_alex(kf,mf,nzp1_alex,nx_alex),
     $                   flk_alex(kg,mf,nzp1_alex,nx_alex),
     $                   flk_alex(kh,mf,nzp1_alex,nx_alex) )
         dlkat = quadget( 1, flk_alex(kf,mf,nzp1_alex,nxm1_alex),
     $                    flk_alex(kg,mf,nzp1_alex,nxm1_alex),
     $                    flk_alex(kh,mf,nzp1_alex,nxm1_alex) )
         dlkaro = quadget( 1, flk_alex(kf,mf,nzp1_alex,nxm2_alex),
     $                     flk_alex(kg,mf,nzp1_alex,nxm2_alex),
     $                     flk_alex(kh,mf,nzp1_alex,nxm2_alex) )
c							 ! or bi-quadratic 
         if ( kf2 .gt. kh ) then
            fzlo = max( 0. , min( 1. ,
     $           ( zlog_alex(kh) - zlogat ) * dzinvlog_alex(kh) ) )
            if ( kf2 .eq. nzp1_alex .and. mf2 .ge. 3 )
     $           fzlo = ( ( xlog_alex(2) - xlogat ) * fzlo
     $           + xlogat * max( 0. , min( 1. ,
     $           ( z_alex(nzp1_alex) - zpxc ) / ( z_alex(nzp1_alex)
     $           - z_alex(nz_alex) - zex_alex ) ) ) )
     $           * dxinvlog_alex(2)
            fzhi = 1. - fzlo
            call quadsto( 1, zlogat, zlog_alex(kg), zlog_alex(kh),
     $                    zlog_alex(kf2) )
            flka = fzlo * flka + fzhi * quadget( 1,
     $           flk_alex(kg,mf,nzp1_alex,nx_alex),
     $           flk_alex(kh,mf,nzp1_alex,nx_alex),
     $           flk_alex(kf2,mf,nzp1_alex,nx_alex) )
            dlkat = fzlo * dlkat + fzhi * quadget( 1,
     $           flk_alex(kg,mf,nzp1_alex,nxm1_alex),
     $           flk_alex(kh,mf,nzp1_alex,nxm1_alex),
     $           flk_alex(kf2,mf,nzp1_alex,nxm1_alex) )
            dlkaro = fzlo * dlkaro + fzhi * quadget( 1,
     $           flk_alex(kg,mf,nzp1_alex,nxm2_alex),
     $           flk_alex(kh,mf,nzp1_alex,nxm2_alex),
     $           flk_alex(kf2,mf,nzp1_alex,nxm2_alex) )
         endif
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_last_alex_edge( fe_a, fe_tr, fe_lo, fe_hi, fe_z )
c     ================================================================
c
      common /c_edge_alex/ fkaedgelo, fkaedgehi, fzkaedge
      save /c_edge_alex/
c
      fe_tr = max( 0.0 , min( fkaedgelo , fkaedgehi ) )
      fe_lo = max( 0.0 , fkaedgelo )
      fe_hi = max( 0.0 , fkaedgehi )
      fe_z = fzkaedge
      fe_a = fe_tr * fzkaedge
c
      return
      end
c
c******************************************************************************
c
      subroutine kapcond( flro, flt, x, y, xCN, xON, xNeHeavy, fmuainv,
     $     fmueinv, zsqbar, ider, flkc, flkct, flkcro, fkcedge, fkcok )
c     =================================================================
c
c  flro = log10(RHO), flt = log10(T), x = X, y = Y, xCN = xC + 0.5 * xN,
c  xON = xO + 0.5 * xN, xNeHeavy = SUM_i{ X_i } for i heavier than oxygen.
c  fmuainv = 1 / mu_A = SUM_i{ X_i / A_i }                 \ Non-positive input
c  fmueinv = 1 / mu_e = SUM_i{ X_i * z_i / A_i }            } for any of these
c  zsqbar = <z**2> * mu_A = SUM_i{ X_i * (z_i)**2 / A_i }  / means "use value
c                                                  from {x,y,xCN,xON,xNeHeavy}"
c....For the Potekhin 2006 ('condall06.d') case:
c  ider =  1 : use bi-quadratic interp, Zion = (<z^2)^0.5, with derivatives.
c          0 : use bi-quadratic interp, Zion = (<z^2)^0.5, no derivatives.
c         -1 : use website formulae, Zion = (<z^2)^0.5, with derivatives.
c         -2 : use bi-quadratic interp, Zion = <z>, with derivatives.
c         -3 : use bi-quadratic interp, Zion = <z>, no derivatives.
c         -4 : use website formulae, Zion = <z>, with derivatives.
c....For the H&L ('Condopac') case:
c  ider = -4 : get "H&L" only (with derivatives)
c         -3 : get "Itoh" only (with derivatives)
c         -2 : get "H&L" only (no derivatives)
c         -1 : get "Itoh" only (no derivatives)
c          0 : combine as necessary (no derivatives): use "H&L" at lower
c               density, "Itoh" at higher density, with switchover region
c          1 : combine the two as necessary, with derivatives
c  RETURNS:
c    flkc = logKc = log10( Kappa_cond )
c    [if ider > 0]: flkct = dlogKc / dlogT , flkcro = dlogKc / dlogRHO
c    fkcedge, fkcok  (strict and loose edge factors)
c
c  NOTE: Itoh (or post-Itoh) code use is determined by  itoh_replace
c
c  NOTE:  "H&L" is W.B.Hubbard & M.Lampe 1969, ApJS 163, 297-346 ;
c        "Itoh" is N.Itoh,S.Mitake,H.Iyetomi,S.Ichimaru 1983, ApJ 273, 774-782
c               plus S.Mitake,S.Ichimaru,N.Itoh 1984, ApJ 277, 375-378 .
c
      parameter ( small_1m6=1.e-6, small_m1m6=-1.e-6, small_5m7=5.e-7 )
c
      parameter ( nT_KcPot=19, nR_KcPot=64, nZ_KcPot=15 )
c
      parameter ( ntlokc=37, ntlokcm1=ntlokc-1, nthikc=90-ntlokcm1,
     $     nrlokc=-23, nrlokcm1=nrlokc-1, nrhikc=24-nrlokcm1, nkc=3,
     $     nthikcm1=nthikc-1, nrhikcm1=nrhikc-1, nkcp1=nkc+1 )
      parameter ( dlt_kc=.1, dlr_kc=.25, dltinv_kc=10., dlrinv_kc=4. )
c
      character*2 celkc_hl(nkc)
      common /c_flkcond_hlpot/ flkc_pot(nT_KcPot,nR_KcPot,nZ_KcPot),
     $     AT_pot(nT_KcPot), AR_pot(nR_KcPot), AZ_pot(nZ_KcPot),
     $     sigconlog_pot, itlo_hl(nrhikc,nkc), ithi_hl(nrhikc,nkc),
     $     irhi_hl(nkc), itlo_ok_hl(nrhikc,nkc),
     $     irjump_hl(nkc), celkc_hl
      save /c_flkcond_hlpot/
c
      dimension flkc_hl(nthikc,nrhikc,nkc),
     $     flrolo_hl(nkc), flrohi_hl(nkc),
     $     fltlo_hl(nkc), flthi_hl(nkc),
     $     flRlo_hl(nkc), flRhi_hl(nkc), kZ_pot(nZ_KcPot)
      equivalence (flkc_pot(1,1,1),flkc_hl(1,1,1)),
     $     (AR_pot(1),flrolo_hl(1)), (AR_pot(nkcp1),flrohi_hl(1)),
     $     (AT_pot(1),fltlo_hl(1)), (AT_pot(nkcp1),flthi_hl(1)),
     $     (AZ_pot(1),flRlo_hl(1)), (AZ_pot(nkcp1),flRhi_hl(1)),
     $     (itlo_hl(1,1),kZ_pot(1))
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      parameter ( nitoh=5 )
c
      common /c_kcond_itoh/ ai_kc(nitoh), ax_kc(0:3,nitoh,3),
     $     bx_kc(0:2,nitoh,3), cx_kc(0:2,nitoh,3)
      save /c_kcond_itoh/
c
      common /c_sw_cond/ flro_kc, flt_kc, xi_kc(nitoh), flkh, flkht,
     $     flkhro, fok_hl, fedge_hl, flki, flkit, flkiro, fok_it,
     $     fedge_it, flkb, flkbt, flkbro, fedge_ok, fedge_kc, fmuai,
     $     fmuei, zsq, flin_itoh, f_itoh, f_hl, dlogt_f_itoh,
     $     dlogro_f_itoh, f_tf, f_rho, f_gam, f_rs, f_rshi, f_gamhi,
     $     f_yi, gamma_ln, y0_it, rr_it, rs_it,
     $     foki_hl(nitoh), flk(nitoh), tlk(nitoh), rlk(nitoh),
     $     kdo_hl, kdo_itoh, k_hl, idus
      save /c_sw_cond/
c
      common/d_opal_z/ dkap
      save /d_opal_z/
c
c  flogitohcon = log10(1.27984e-7) = -6.892844
c  flngammacon = ln(2.275e5) = 12.334906, finvln2 = 1/ln2 = 1.4426950,
c  flogtfcon = log10(5.930e9) = 9.773055, pi = 3.141593,
c  pisq = pi**2 = 9.869604, sixopisq = 6./pi**2, fouropisq = 4./pi**2
c  gamma_ln_max = ln(171.) = 5.141664, finv2ln2 = 1/2ln2 = .7213475,
c  xg_max = 0.45641 * gamma_ln_max - 1.31636 = 1.0303467
c
      parameter ( dlkc_ovsc=0.12, dlkc_nevsc=0.26 )
c
      parameter ( fln10 = 2.302585, floge = .4342945 )
      parameter ( flogitohcon = -6.892844, flngammacon = 12.334906,
     $     finvln2 = 1.4426950, flogtfcon = 9.773055,
     $     gamma_ln_max = 5.141664, ratsqo4con = 9.291e-3 / 4.,
     $     xg_max = 0.45641 * gamma_ln_max - 1.31636,
     $     dlnt_xg = -0.45641, dlnro_xg = 0.45641 / 3., 
     $     finv2ln2 = finvln2 / 2., f13 = 1. / 3.,
     $     fm13 = -1. / 3., f23 = 2. / 3., f16 = 1. / 6. )
      parameter ( pi = 3.141593, pisq = pi * pi, sixopisq = 6. / pisq,
     $     fouropisq = 4. / pisq, fouropisq23 = fouropisq + f23 )
c
      dimension xi_hl(nitoh), ftfj_kr(0:1)
      dimension fkoft(0:3), d_fkoft(0:3), sj(3), dxg_sj(3), drs_sj(3)
c
      parameter ( dlt2kc=dlt_kc+dlt_kc, dlt3kc=dlt2kc+dlt_kc )
      parameter ( dlr2kc=dlr_kc+dlr_kc, dlr3kc=dlr2kc+dlr_kc )
      parameter ( rslope=f13, rslope_mat=rslope*dltinv_kc*dlr_kc,
     $     id21s=6, finv21s=1./id21s, dlrinv_s=dlrinv_kc/id21s )
c
      parameter ( badlogkval=1.e+35 )
c-debug[
c-debug;      common /c_debug_kcond/ i_debug_kcond
c-debug;      save /c_debug_kcond/
c-debug;ccc
c-debug;      data i_debug_kcond / 0 /
c-debug]
c===
      flkc = badlogkval
      flkct = 0.0
      flkcro = 0.0
      kdo_hl = 0
      kdo_itoh = 0
      fedge_kc = -99999.
      fkcedge = -99999.
      fedge_ok = -99999.
      fkcok = -99999.
c
      flro_kc = flro
      flt_kc = flt
c
      xi_kc(1) = x
      xi_kc(2) = y
      xi_kc(3) = xCN
      xi_kc(4) = xON
      xi_kc(5) = xNeHeavy
c
      if ( kavail_cond .le. 0 ) return
c
      if ( kavail_cond .le. 1 .or.
     $     min( fmuainv , fmueinv , zsqbar ) .le. 0.0 ) then
         if ( abs( x + y + xCN + xON + xNeHeavy - 1. ) .gt.
     $        small_1m6 ) then
            write(6,10) flro, flt, 'sum{Xi} is not unity:',
     $           x, y, xCN, xON, xNeHeavy
 10         format(/' KAPCOND Error: At logRHO=',f11.6,' logT=',f10.6,
     $           ', ',a/' KAPCOND Error: Xi=',5f12.8)
            stop ' STOP -- KAPCOND Error: sum{Xi} is not unity. '
         else if ( min( x , y , xCN , xON , xNeHeavy ) .lt.
     $           small_m1m6 ) then
            write(6,10) flro, flt, 'negative Xi value:',
     $           x, y, xCN, xON, xNeHeavy
            stop ' STOP -- KAPCOND Error: negative Xi value. '
         endif
      endif
c
      if ( fmuainv .gt. 0.0 ) then
         fmuai = fmuainv
      else
         fmuai = xi_kc(1) / ai_kc(1) + xi_kc(2) / ai_kc(2)
     $        + xi_kc(3) / ai_kc(3) + xi_kc(4) / ai_kc(4)
     $        + xi_kc(5) / ai_kc(5)
      endif
c
      if ( kavail_cond .le. 1 .or. ider .le. -2 ) then
c
         if ( fmueinv .gt. 0.0 ) then
            fmuei = fmueinv
         else
            fmuei = xi_kc(1) / ai_kc(1) + xi_kc(2) * 2. / ai_kc(2)
     $           + xi_kc(3) * 6. / ai_kc(3) + xi_kc(4) * 8. / ai_kc(4)
     $           + xi_kc(5) * 10. / ai_kc(5)
         endif
c					! Pothekin 2006, with Zion = <z>
         if ( kavail_cond .gt. 1 ) then
c
            call kap_cond_pot( flro, flt, fmuei / fmuai, ider + 3,
     $                         flkc, flkct, flkcro, fkcedge, fkcok )
            return
c
         endif
c
      endif
c
      if ( zsqbar .gt. 0.0 ) then
         zsq = zsqbar
      else
         zsq = xi_kc(1) / ai_kc(1) + xi_kc(2) * 4. / ai_kc(2)
     $        + xi_kc(3) * 36. / ai_kc(3) + xi_kc(4) * 64. / ai_kc(4)
     $        + xi_kc(5) * 100. / ai_kc(5)
      endif
c				     ! Pothekin 2006, with Zion = (<z^2>)^0.5
      if ( kavail_cond .gt. 1 ) then
c
         call kap_cond_pot( flro, flt, sqrt( zsq / fmuai ), ider,
     $                      flkc, flkct, flkcro, fkcedge, fkcok )
         return
c
      endif
c
c  If NOT Pothekin 2006 case, continue, and get H&L/Itoh conductive opacities.
c
      flkc = 0.0
c
      flkh = 0.0
      flkht = 0.0
      flkhro = 0.0
      flki = 0.0
      flkit = 0.0
      flkiro = 0.0
      flkb = 0.0
      flkbt = 0.0
      flkbro = 0.0
c			! these initializations just prevent compiler warnings:
      i1s = 0
      tf_1 = 1.0
      frs = 1.0
      omfrs = 0.0
      frj = 1.0
      omfrj = 0.0
      dlnro_rs = 0.0
      dlnt_y0 = 0.0
      dlnro_y0 = 0.0
      dlnro_rr = 0.0
      dlnro_fim1 = 0.0
      dlnro_fip1 = 0.0
      dlnro_fip3 = 0.0
c
      if ( ider .ge. -2 ) then
         idus = ider
      else
         idus = 1
      endif
c
      fmuei_ln = log( fmuei )
c
      gamma_ln = flngammacon + fln10 * ( flro * f13 - flt )
     $     + log( zsq ) - f23 * log( fmuai )
c
      rom13 = ( fmuei * 10.**flro )**f13
      rom23 = rom13**2
c
      v_rom23 = 1.018e-4 * rom23
      omrr = 1. / ( 1. + v_rom23 )
      rr_it = v_rom23 * omrr
c
      rs_it = 1.388 / rom13
c
      if ( v_rom23 .gt. 0.025 ) then
         tf_1 = sqrt( 1. + v_rom23 )
         tf_arg_log = tf_1 - 1.
         tf_fac_log = log10( tf_arg_log )
      else
         tf_arg_log = ( ( 0.0625 * v_rom23 - 0.125 )
     $        * v_rom23 + 0.5 ) * v_rom23
         tf_fac_log = log10( tf_arg_log )
      endif
      f_tf = ( flogtfcon + tf_fac_log - 0.8 - flt ) * 2.5
c
      f_rho = flro - 6.
c
      f_gam = gamma_ln * finv2ln2 + 0.5
c
      f_rs = ( flro + floge * fmuei_ln - 1.0803 ) * 2.
c
      f_rshi = ( 12.9272 - flro - floge * fmuei_ln ) * 2.
c
      f_gamhi = 1. - ( gamma_ln - gamma_ln_max ) * finvln2
c
      y0_it = 165.6 * rom23 * 10.**( -flt )
      f_yi = 1.0
      do i = 1, nitoh
         if ( xi_kc(i) .gt. 0.0 ) f_yi = f_yi - xi_kc(i)
     $        * max( 0. , 1. + log10( y0_it / ai_kc(i) ) * 2. )
      enddo
c
      fkcedge = 1.
      fedge_hl = 1.
      fedge_it = 1.
      fok_hl = min( 1. , 1. - f_rho ,
     $     ( 9.2 - flt ) * 5. , ( flt - 2.8 ) * 5. )
      fok_it = min( 1. , f_tf , f_gam , f_rs ,
     $     f_rshi , f_gamhi , f_yi )
c
      flin_itoh = min( 1. ,
     $     max( 0. , f_rho , min( f_tf , f_gam , f_rs ) ) )
c
      dlogt_f_itoh = 0.0
      dlogro_f_itoh = 0.0
      kdo_hl = 1
      kdo_itoh = 1
c
      if ( ider .le. -4 .or. ider .eq. -2 .or.
     $     ( ider .ge. 0 .and. flin_itoh .eq. 0. ) ) then
c
         if ( ider .lt. 0 ) then
            kdo_itoh = 0
         else if ( ider .le. 1 ) then
            kdo_itoh = -1
         endif
         f_itoh = 0.
         f_hl = 1.
c
      else if ( ider .lt. 0 .or. flin_itoh .eq. 1. ) then
c
         if ( ider .lt. 0 ) then
            kdo_hl = 0
         else if ( ider .le. 1 ) then
            kdo_hl = -1
         endif
         f_itoh = 1.
         f_hl = 0.
c
      else
c
         if ( idus .gt. 0 ) then
c
            if ( flin_itoh .eq. f_rho ) then
               dlogt_f_itoh = 0.0
               dlogro_f_itoh = 1.
            else if ( flin_itoh .eq. f_rs ) then
               dlogt_f_itoh = 0.0
               dlogro_f_itoh = 2.
            else if ( flin_itoh .eq. f_gam ) then
               dlogt_f_itoh = - fln10 * finv2ln2
               dlogro_f_itoh = fln10 * finv2ln2 / 3.
            else if ( flin_itoh .eq. f_tf ) then
               dlogt_f_itoh = -2.5
               if ( v_rom23 .gt. 0.025 ) then
                  dlogro_f_itoh = 1.25 * v_rom23 * f23
     $                 / ( tf_1 * tf_arg_log )
               else
                  dlogro_f_itoh = 2.5 * ( ( 0.1875 * v_rom23
     $                 - 0.25 ) * v_rom23 + 0.5 )
     $                 * v_rom23 * f23 / tf_arg_log
               endif
            endif
c
         endif
c
         if ( flin_itoh .le. 0.5 ) then
            f_itoh = 2. * flin_itoh**2
            f_hl = 1. - f_itoh
            dlogt_f_itoh = 4. * flin_itoh * dlogt_f_itoh
            dlogro_f_itoh = 4. * flin_itoh * dlogro_f_itoh
         else
            f_hl = 2. * ( 1. - flin_itoh )**2
            f_itoh = 1. - f_hl
            dlogt_f_itoh = 4. * ( 1. - flin_itoh ) * dlogt_f_itoh
            dlogro_f_itoh = 4. * ( 1. - flin_itoh ) * dlogro_f_itoh
         endif
c
      endif
c-debug[
c-debug;      if ( i_debug_kcond .gt. 0 ) write(6,1733) flt, flro,
c-debug;     $     (xi_kc(i),i=1,5), f_hl, f_itoh, dlogt_f_itoh,
c-debug;     $     dlogro_f_itoh, ider, idus
c-debug; 1733 format(/' KAPCOND: logT,RHO',f10.6,f11.6,' Xi',5f12.8,
c-debug;     $     ' f_hl,itoh',2f12.8,' dt,r_f_itoh',2f12.8,
c-debug;     $     ' ider',i3,' idus',i3)
c-debug]
c				! get lower-rho Kcond (log rho < 6) from tables
c				! W.B.Hubbard & M.Lampe 1969, ApJS 163, 297-346
      if ( kdo_hl .gt. 0 ) then
c
         xi_hl(1) = xi_kc(1)
         xi_hl(2) = xi_kc(2)
         xi_hl(3) = xi_kc(3) + xi_kc(4) + xi_kc(5)
c-debug[
c-debug;         if ( i_debug_kcond .gt. 1 )
c-debug;     $        write(6,'(" xi_hl=",3f12.8)')
c-debug;     $        xi_hl(1),xi_hl(2),xi_hl(3)
c-debug]
c						! get T,RHO position in matrix
         den = flro * dlrinv_kc - nrlokcm1
         fedge_hl = min( fedge_hl , den * 0.5 + 0.5  ,
     $        ( nrhikc + 2 - den ) * 0.5 )
         ir = max( 0 , min( nrhikc , int(den) ) )
         irf = max( 1 , min( nrhikcm1 , ir - 1 ) )
         irf2 = max( 2 , min( nrhikc , ir + 2 ) )
         irg = irf + 1
         irh = irf + 2
         frf = ( den - irf ) * dlr_kc
         ir1 = max( 1 , min( nrhikcm1 , ir ) )
         ir2 = ir1 + 1
         fr = den - ir1
         omfr = 1. - fr
c				   ! for logRHO < 0, is O.K. up to OPAL high-R
         if ( flro .gt. 0.5 ) then
            foki_rmin = 0.0
         else
            foki_rmin = min( 1.0 , max( 0.0 , ( 0.5 - flro ) * 2.0 ) ,
     $           max( 0.0 , ( -5.75 - flro ) * 4.0 ,
     $           ( 1.5 - flro + ( flt - 6.0 ) * 3.0 ) * 2.0 ) )
         endif
c
         tem = flt * dltinv_kc - ntlokcm1
         it = max( 0 , min( nthikc , int(tem) ) )
         itf = max( 1 , min( nthikcm1 , it - 1 ) )
         itf2 = max( 2 , min( nthikc , it + 2 ) )
         itg = itf + 1
         ith = itf + 2
         ftf = ( tem - itf ) * dlt_kc
         it1 = max( 1 , min( nthikcm1 , it ) )
         it2 = it1 + 1
         ft = tem - it1
         omft = 1. - ft
c
         k_hl = 0
         do k = 1, nitoh
            if ( xi_kc(k) .gt. 0.0 ) then
               if ( k_hl .eq. 0 ) then
                  k_hl = - k
               else
                  k_hl = k
               endif
            endif
            flk(k) = 0.0
            tlk(k) = 0.0
            rlk(k) = 0.0
            foki_hl(k) = 1.0
         enddo
c
         flks = 0.0
         tlks = 0.0
         rlks = 0.0
c
         if ( irf2 .eq. 2 .and. fr .lt. 0.0 ) then
c
            islope = 1
            if ( fr .gt. -1.0 ) islope = -1
c
            i1s = 1
            i2s = i1s + id21s
            frj = fr * finv21s
            omfrj = 1. - frj
            frs = max( 0. , min( 1. , fr + 1.0 ) )
            omfrs = 1. - frs
            ftfj_kr(0) = -1.e36
            ftfj_kr(1) = -1.e36
c
         else if ( irf .eq. nrhikcm1 .and. fr .gt. 1.0 ) then
c
            islope = 1
            if ( fr .lt. 2.0 ) islope = -1
c
            i2s = nrhikc
            i1s = i2s - id21s
            frj = ( fr - 1. ) * finv21s + 1.
            omfrj = 1. - frj
            frs = max( 0. , min( 1. , 2.0 - fr ) )
            omfrs = 1. - frs
            ftfj_kr(0) = -1.e36
            ftfj_kr(1) = -1.e36
c
         else
c
            islope = 0
c
         endif
c-debug[
c-debug;         if ( i_debug_kcond .gt. 2 ) write(6,
c-debug;     $        '(" ir,f,g,h,f2,islope=",6i3," den,frf,fr",1p,3e15.7)')
c-debug;     $        ir,irf,irg,irh,irf2,islope,den,frf,fr
c-debug;         if ( i_debug_kcond .gt. 2 ) write(6,
c-debug;     $        '(" it,f,g,h,f2=",i10,4i3,"    tem,ftf,ft",1p,3e15.7)')
c-debug;     $        it,itf,itg,ith,itf2,tem,ftf,ft
c-debug]
c
         if ( islope .le. 0 ) then
            call qdersto( 1, frf, 0.0, dlr_kc, dlr2kc )
            if ( irf2 .gt. irh )
     $           call qdersto( 2, frf, dlr_kc, dlr2kc, dlr3kc )
c
            if ( itf2 .ge. ith ) then
               call qdersto( 3, ftf, 0.0, dlt_kc, dlt2kc )
               if ( itf2 .gt. ith )
     $              call qdersto( 4, ftf, dlt_kc, dlt2kc, dlt3kc )
            endif
         endif
c
         do k = 1, 3
c
            if ( xi_hl(k) .gt. 0.0 ) then
c
               if ( islope .le. 0 ) then
c						! O.K. to be in gap...
                  i = irjump_hl(k)
                  j = i
                  if ( i .lt. ir1 .or.
     $                 itlo_hl(ir1,k) .lt. itlo_hl(i,k) ) i = ir1
                  if ( j .lt. ir2 .or.
     $                 itlo_hl(ir2,k) .lt. itlo_hl(j,k) ) j = ir2
                  tmp = max( foki_rmin ,
     $                 1. + tem - omfr * itlo_hl(i,k)
     $                 - fr * itlo_hl(j,k) )
c
                  foki_hl(k) = min( foki_hl(k) , tmp ,
     $                 1. + omfr * ithi_hl(ir1,k)
     $                 + fr * ithi_hl(ir2,k) - tem )
                  fedge_hl = min( fedge_hl , foki_hl(k) )
                  if ( i .ne. ir1 .or. j .ne. ir2 .or.
     $                 foki_rmin .gt. 0.0 )
     $                 fedge_hl = min( fedge_hl , 1. + tem
     $                 - omfr * itlo_hl(ir1,k) - fr * itlo_hl(ir2,k) )
c
c-debug[
c-debug;                  if ( i_debug_kcond .gt. 2 ) write(6,
c-debug;     $                 '("  k=",i1," xi_hl(k)=",1p,e15.7)')
c-debug;     $                 k, xi_hl(k)
c-debug]
c
                  do kt = itf, itf2
c
                     jt = kt - itf
c
                     if ( irf2 .lt. irh ) then
                        fkoft(jt) = omfr * flkc_hl(kt,irf,k)
     $                       + fr * flkc_hl(kt,irf2,k)
                        if ( idus .gt. 0 )
     $                       d_fkoft(jt) = ( flkc_hl(kt,irf2,k)
     $                       - flkc_hl(kt,irf,k) ) * dlrinv_kc
c-debug[
c-debug;                        if ( i_debug_kcond .gt. 3 ) write(6,1893)
c-debug;     $                       '=2',k,kt,jt,fkoft(jt),d_fkoft(jt),
c-debug;     $                       irf,flkc_hl(kt,irf,k),
c-debug;     $                       irf2,flkc_hl(kt,irf2,k)
c-debug; 1893                   format('   [',a2,']k,kt,jt',3i3,
c-debug;     $                       ' fkoft(jt),dr',1p,2e15.7,
c-debug;     $                       ' <--',4(i4,e15.7))
c-debug]
                     else
                        call qderget( 1, flkc_hl(kt,irf,k),
     $                                flkc_hl(kt,irg,k),
     $                                flkc_hl(kt,irh,k),
     $                                fkoft(jt), d_fkoft(jt) )
c-debug[
c-debug;                        if ( i_debug_kcond .gt. 3 ) write(6,1893)
c-debug;     $                       '>2',k,kt,jt,fkoft(jt),d_fkoft(jt),
c-debug;     $                       (i,flkc_hl(kt,i,k),i=irf,irh)
c-debug]
                        if ( irf2 .gt. irh ) then
                           if ( idus .gt. 0 ) then
                              call qderget( 2, flkc_hl(kt,irg,k),
     $                                      flkc_hl(kt,irh,k),
     $                                      flkc_hl(kt,irf2,k),
     $                                      tmp, dkap )
                              d_fkoft(jt) =
     $                             omfr * d_fkoft(jt) + fr * dkap
     $                             + ( tmp - fkoft(jt) ) * dlrinv_kc
                              fkoft(jt) = omfr * fkoft(jt) + fr * tmp
                           else
                              fkoft(jt) = omfr * fkoft(jt) + fr
     $                             * quadget( 2, flkc_hl(kt,irg,k),
     $                                        flkc_hl(kt,irh,k),
     $                                        flkc_hl(kt,irf2,k) )
                           endif
c-debug[
c-debug;                           if ( i_debug_kcond .gt. 3 ) write(6,1893)
c-debug;     $                          '=4',k,kt,jt,fkoft(jt),d_fkoft(jt),
c-debug;     $                          (i,flkc_hl(kt,i,k),i=irf,irf2)
c-debug]
                        else if ( irf .eq. 1 ) then
                           tmp = omfr * flkc_hl(kt,1,k)
     $                          + fr * flkc_hl(kt,2,k)
                           if ( idus .gt. 0 ) d_fkoft(jt) =
     $                          fr * d_fkoft(jt) + ( fkoft(jt) - tmp
     $                          + omfr * ( flkc_hl(kt,2,k)
     $                          - flkc_hl(kt,1,k) ) ) * dlrinv_kc
                           fkoft(jt) = omfr * tmp + fr * fkoft(jt)
c-debug[
c-debug;                           if ( i_debug_kcond .gt. 3 ) write(6,1893)
c-debug;     $                          '23',k,kt,jt,fkoft(jt),d_fkoft(jt),
c-debug;     $                          (i,flkc_hl(kt,i,k),i=1,2)
c-debug]
                        else
                           tmp = omfr * flkc_hl(kt,nrhikcm1,k)
     $                          + fr * flkc_hl(kt,nrhikc,k)
                           if ( idus .gt. 0 ) d_fkoft(jt) =
     $                          omfr * d_fkoft(jt) + ( tmp - fkoft(jt)
     $                          + fr * ( flkc_hl(kt,nrhikc,k)
     $                          - flkc_hl(kt,nrhikcm1,k) ) )
     $                          * dlrinv_kc
                           fkoft(jt) = omfr * fkoft(jt) + fr * tmp
c-debug[
c-debug;                           if ( i_debug_kcond .gt. 3 ) write(6,1893)
c-debug;     $                          '32',k,kt,jt,fkoft(jt),d_fkoft(jt),
c-debug;     $                          (i,flkc_hl(kt,i,k),i=nrhikcm1,nrhikc)
c-debug]
                        endif
                     endif
c
                  enddo
c
                  if ( itf2 .lt. ith ) then
                     flk(k) = omft * fkoft(0) + ft * fkoft(1)
                     if ( idus .gt. 0 ) then
                        tlk(k) = ( fkoft(1) - fkoft(0) ) * dltinv_kc
                        rlk(k) = omft * d_fkoft(0) + ft * d_fkoft(1)
                     endif
c-debug[
c-debug;                     if ( i_debug_kcond .gt. 2 ) write(6,1894)
c-debug;     $                    '=2',k,flk(k),tlk(k),rlk(k),
c-debug;     $                    0,fkoft(0),1,fkoft(1),
c-debug;     $                    0,d_fkoft(0),1,d_fkoft(1)
c-debug; 1894                format('  [',a2,']k',i3,
c-debug;     $                    ' flk(k),dt,dr',1p,3e15.7,
c-debug;     $                    ' <--',8(i4,e15.7))
c-debug]
                  else
                     if ( idus .gt. 0 ) then
                        call qderget( 3, fkoft(0), fkoft(1), fkoft(2),
     $                                flk(k), tlk(k) )
                        rlk(k) = quadget( 3, d_fkoft(0),
     $                                    d_fkoft(1), d_fkoft(2) )
                     else
                        flk(k) = quadget( 3, fkoft(0),
     $                                    fkoft(1), fkoft(2) )
                     endif
c-debug[
c-debug;                     if ( i_debug_kcond .gt. 2 ) write(6,1894)
c-debug;     $                    '>2',k,flk(k),tlk(k),rlk(k),
c-debug;     $                    0,fkoft(0),1,fkoft(1),2,fkoft(2),
c-debug;     $                    0,d_fkoft(0),1,d_fkoft(1),2,d_fkoft(2)
c-debug]
                     if ( itf2 .gt. ith ) then
                        if ( idus .gt. 0 ) then
                           call qderget( 4, fkoft(1), fkoft(2),
     $                                   fkoft(3), tmp, dkap )
                           tlk(k) = omft * tlk(k) + ft * dkap
     $                          + ( tmp - flk(k) ) * dltinv_kc
                           flk(k) = omft * flk(k) + ft * tmp
                           rlk(k) = omft * rlk(k) + ft * quadget( 4,
     $                          d_fkoft(1), d_fkoft(2), d_fkoft(3) )
                        else
                           flk(k) = omft * flk(k) + ft * quadget( 4,
     $                          fkoft(1), fkoft(2), fkoft(3) )
                        endif
c-debug[
c-debug;                        if ( i_debug_kcond .gt. 2 ) write(6,1894)
c-debug;     $                       '=4',k,flk(k),tlk(k),rlk(k),
c-debug;     $                       (i,fkoft(i),i=0,3),(i,d_fkoft(i),i=0,3)
c-debug]
                     else if ( itf .eq. 1 ) then
                        tmp = omft * fkoft(0) + ft * fkoft(1)
                        if ( idus .gt. 0 ) then
                           tlk(k) = ft * tlk(k) + ( flk(k) - tmp + omft
     $                          * ( fkoft(1) - fkoft(0) ) ) * dltinv_kc
                           rlk(k) = ft * rlk(k) + omft * ( omft
     $                          * d_fkoft(0) + ft * d_fkoft(1) )
                        endif
                        flk(k) = omft * tmp + ft * flk(k)
c-debug[
c-debug;                        if ( i_debug_kcond .gt. 2 ) write(6,1894)
c-debug;     $                       '23',k,flk(k),tlk(k),rlk(k),
c-debug;     $                       (i,fkoft(i),i=0,1),(i,d_fkoft(i),i=0,1)
c-debug]
                     else
                        tmp = omft * fkoft(1) + ft * fkoft(2)
                        if ( idus .gt. 0 ) then
                           tlk(k) = omft * tlk(k) + ( tmp - flk(k) + ft
     $                          * ( fkoft(2) - fkoft(1) ) ) * dltinv_kc
                           rlk(k) = omft * rlk(k) + ft * ( omft
     $                          * d_fkoft(1) + ft * d_fkoft(2) )
                        endif
                        flk(k) = omft * flk(k) + ft * tmp
c-debug[
c-debug;                        if ( i_debug_kcond .gt. 2 ) write(6,1894)
c-debug;     $                       '32',k,flk(k),tlk(k),rlk(k),
c-debug;     $                       (i,fkoft(i),i=1,2),(i,d_fkoft(i),i=1,2)
c-debug]
                     endif
                  endif
c
               endif
c
               if ( islope .ne. 0 ) then
c
                  do kr = 0, 1
c
                     jr = id21s * kr + i1s
                     temj = tem + ( jr - den ) * rslope_mat
                     jt = max( 0 , min( nthikc , int(temj) ) )
                     jtf = max( 1 , min( nthikcm1 , jt - 1 ) )
                     jtf2 = max( 2 , min( nthikc , jt + 2 ) )
                     jtg = jtf + 1
                     jth = jtf + 2
                     ftfj = ( temj - jtf ) * dlt_kc
                     ftj = temj - max( 1 , min( nthikcm1 , jt ) )
                     omftj = 1. - ftj
c
                     tmp = 1. + temj - itlo_hl(jr,k)
                     foki_hl(k) = min( foki_hl(k) ,
     $                    1. + ithi_hl(jr,k) - temj ,
     $                    max( tmp , foki_rmin ) )
                     fedge_hl = min( fedge_hl , foki_hl(k) , tmp )
c-debug[
c-debug;                     if ( i_debug_kcond .gt. 2 ) write(6,
c-debug;     $                    '(" jr,t,f:f2=",6i3," tem,ftf,tj",1p,3e15.7)'
c-debug;     $                    ) jr,jt,jtf,jtg,jth,jtf2,temj,ftfj,ftj
c-debug]
c
                     if ( jtf2 .lt. jth ) then
                        fkoft(kr) = omftj * flkc_hl(jtf,jr,k)
     $                       + ftj * flkc_hl(jtf2,jr,k)
                        if ( idus .gt. 0 )
     $                       d_fkoft(kr) = ( flkc_hl(jtf2,jr,k)
     $                       - flkc_hl(jtf,jr,k) ) * dltinv_kc
c-debug[
c-debug;                        if ( i_debug_kcond .gt. 3 ) write(6,1891)
c-debug;     $                       '=2',k,jr,jt,kr,fkoft(kr),d_fkoft(kr),
c-debug;     $                       jtf,flkc_hl(jtf,jr,k),
c-debug;     $                       jtf2,flkc_hl(jtf2,jr,k)
c-debug; 1891                   format('   [',a2,']k,jr,jt',3i3,
c-debug;     $                       ' fkoft(kr=',i1,'),dt',1p,2e15.7,
c-debug;     $                       ' <--',4(i4,e15.7))
c-debug]
                     else
                        if ( abs( ftfj_kr(kr) - ftfj ) .gt.
     $                       small_5m7 ) then
                           ftfj_kr(kr) = ftfj
                           call qdersto( 5 + kr, ftfj,
     $                                   0.0, dlt_kc, dlt2kc )
                           if ( jtf2 .gt. jth ) call qdersto( 7 + kr,
     $                          ftfj, dlt_kc, dlt2kc, dlt3kc )
                        endif
                        call qderget( 5 + kr, flkc_hl(jtf,jr,k),
     $                                flkc_hl(jtg,jr,k),
     $                                flkc_hl(jth,jr,k),
     $                                fkoft(kr), d_fkoft(kr) )
c-debug[
c-debug;                        if ( i_debug_kcond .gt. 3 ) write(6,1891)
c-debug;     $                       '>2',k,jr,jt,kr,fkoft(kr),d_fkoft(kr),
c-debug;     $                       (i,flkc_hl(i,jr,k),i=jtf,jth)
c-debug]
                        if ( jtf2 .gt. jth ) then
                           if ( idus .gt. 0 ) then
                              call qderget( 7 + kr, flkc_hl(jtg,jr,k),
     $                                      flkc_hl(jth,jr,k),
     $                                      flkc_hl(jtf2,jr,k),
     $                                      tmp, dkap )
                              d_fkoft(kr) = omftj * d_fkoft(kr)
     $                             + ftj * dkap
     $                             + ( tmp - fkoft(kr) ) * dltinv_kc
                              fkoft(kr) = omftj * fkoft(kr) + ftj * tmp
                           else
                              fkoft(kr) = omftj * fkoft(kr) + ftj
     $                             * quadget( 7 + kr,
     $                                        flkc_hl(jtg,jr,k),
     $                                        flkc_hl(jth,jr,k),
     $                                        flkc_hl(jtf2,jr,k) )
                           endif
c-debug[
c-debug;                           if ( i_debug_kcond .gt. 3 ) write(6,1891)
c-debug;     $                          '=4',k,jr,jt,kr,fkoft(kr),d_fkoft(kr),
c-debug;     $                          (i,flkc_hl(i,jr,k),i=jtf,jtf2)
c-debug]
                        else if ( jtf .eq. 1 ) then
                           tmp = omftj * flkc_hl(1,jr,k)
     $                          + ftj * flkc_hl(2,jr,k)
                           if ( idus .gt. 0 ) d_fkoft(kr) =
     $                          ftj * d_fkoft(kr) + ( fkoft(kr) - tmp
     $                          + omftj * ( flkc_hl(2,jr,k)
     $                          - flkc_hl(1,jr,k) ) ) * dltinv_kc
                           fkoft(kr) = omftj * tmp + ftj * fkoft(kr)
c-debug[
c-debug;                           if ( i_debug_kcond .gt. 3 ) write(6,1891)
c-debug;     $                          '23',k,jr,jt,kr,fkoft(kr),d_fkoft(kr),
c-debug;     $                          (i,flkc_hl(i,jr,k),i=1,2)
c-debug]
                        else
                           tmp = omftj * flkc_hl(nthikcm1,jr,k)
     $                          + ftj * flkc_hl(nthikc,jr,k)
                           if ( idus .gt. 0 ) d_fkoft(kr) =
     $                          omftj * d_fkoft(kr) + ( tmp - fkoft(kr)
     $                          + ftj * ( flkc_hl(nthikc,jr,k)
     $                          - flkc_hl(nthikcm1,jr,k) ) )
     $                          * dltinv_kc
                           fkoft(kr) = omftj * fkoft(kr) + ftj * tmp
c-debug[
c-debug;                           if ( i_debug_kcond .gt. 3 ) write(6,1891)
c-debug;     $                          '32',k,jr,jt,kr,fkoft(kr),d_fkoft(kr),
c-debug;     $                          (i,flkc_hl(i,jr,k),i=nthikcm1,nthikc)
c-debug]
                        endif
c
                     endif
c
                  enddo
c
                  flks = omfrj * fkoft(0) + frj * fkoft(1)
c
                  if ( idus .gt. 0 ) then
                     tlks = omfrj * d_fkoft(0) + frj * d_fkoft(1)
                     rlks = ( fkoft(1) - fkoft(0) ) * dlrinv_s
     $                    - rslope * tlks
                  endif
c-debug[
c-debug;                  if ( i_debug_kcond .gt. 2 ) write(6,1892)
c-debug;     $                 k, frj, flks, tlks, rlks, 0, fkoft(0),
c-debug;     $                 1, fkoft(1), 0, d_fkoft(0), 1, d_fkoft(1)
c-debug; 1892             format('  [=2s]k',i3,' frj',1p,e15.7,
c-debug;     $                 ' flks:k,dt,dr',1p,3e15.7,
c-debug;     $                 ' <--',6(i4,e15.7))
c-debug]
c
                  if ( islope .gt. 0 ) then
                     flk(k) = flks
                     tlk(k) = tlks
                     rlk(k) = rlks
                  else
c-debug[
c-debug;                     if ( i_debug_kcond .gt. 2 ) write(6,1899)
c-debug;     $                    k, frs, flks * omfrs + flk(k) * frs,
c-debug;     $                    tlks * omfrs + tlk(k) * frs,
c-debug;     $                    rlks * omfrs + rlk(k) * frs + max(-1,2-irf)
c-debug;     $                    * ( flk(k) - flks ) * dlrinv_kc,
c-debug;     $                    0, flks, 1, flk(k), 0, tlks, 1, tlk(k),
c-debug;     $                    0, rlks, 1, rlk(k)
c-debug; 1899                format('  [s+2]k',i3,' frs',1p,e15.7,
c-debug;     $                    ' flk(k),dt,dr',1p,3e15.7,
c-debug;     $                    ' <--',6(i4,e15.7))
c-debug]
                     tlk(k) = tlks * omfrs + tlk(k) * frs
                     rlk(k) = rlks * omfrs + rlk(k) * frs
                     if ( irf2 .eq. 2 ) then
                        rlk(k) = rlk(k) + ( flk(k) - flks ) * dlrinv_kc
                     else
                        rlk(k) = rlk(k) + ( flks - flk(k) ) * dlrinv_kc
                     endif
                     flk(k) = flks * omfrs + flk(k) * frs
                  endif
c
               endif
c
               if ( k .eq. 3 ) then
c						! get approximate Kc(Oxygen)
                  flk(4) = flk(3) + dlkc_ovsc
                  tlk(4) = tlk(3)
                  rlk(4) = rlk(3)
                  foki_hl(4) = foki_hl(3)
c						! get approximate Kc(Ne...)
                  flk(5) = flk(3) + dlkc_nevsc
                  tlk(5) = tlk(3)
                  rlk(5) = rlk(3)
                  foki_hl(5) = foki_hl(3)

               endif
c
            endif
c
         enddo
c					! if there is only one X(i) non-zero:
         if ( k_hl .lt. 0 ) then
c
            k = iabs(k_hl)
c
            fok_hl = min( fok_hl , foki_hl(k) )
c
            flkh = flk(k)
            flkht = tlk(k)
            flkhro = rlk(k)
c					! else: more than one: sum over X(i):
         else
c
            tmp = 0.
            ssq = 0.
c			    ! get preliminary  flkh = Kc(k_hl) / Kc
c			    !              = SUM_i{ X(i) * Kc(k_hl) / Kc(i) } ,
c			    ! flkht = ( Kc(k_hl) / Kc ) * ( d logKc / d logT )
c			    !       = SUM_i{ ( d logKc(k_hl) / d logT )
c			    !                * X(i) * Kc(k_hl) / Kc(i) } ,
c			    ! flkhro = similar
            do k = 1, nitoh
               if ( xi_kc(k) .gt. 0.0 ) then
                  ssq = ssq + sqrt( xi_kc(k) )
                  tmp = tmp + foki_hl(k) * sqrt( xi_kc(k) )
                  if ( k .eq. k_hl ) then
                     flkinv = 1.0
                     flkh = flkh + xi_kc(k)
                  else
                     flkinv = 10.**min( 35. , flk(k_hl) - flk(k) )
                     flkh = flkh + xi_kc(k) * flkinv
                  endif
                  if ( idus .gt. 0 ) then
                     flkht = flkht + xi_kc(k) * flkinv * tlk(k)
                     flkhro = flkhro + xi_kc(k) * flkinv * rlk(k)
                  endif
               endif
            enddo
c
            fok_hl = min( fok_hl , tmp / ssq )
c
            if ( flkh .le. 0.0 ) stop
     $           ' STOP -- KAPCOND Error: Kcond(H&L) < 0 cannot be. '
c
c					! convert to  flkh = logKc ,
c					!  flkht = ( d logKc / d logT ) ,
c					!  flkhro = ( d logKc / d logRHO )
            if ( idus .gt. 0 ) then
               flkht = flkht / flkh
               flkhro = flkhro / flkh
            endif
            flkh = flk(k_hl) - log10( flkh )
c
         endif
c
c-debug[
c-debug;         if ( i_debug_kcond .gt. 0 ) write(6,1897) flkh,flkht,flkhro,
c-debug;     $        max( fedge_hl , 0.0 ), max( 0.0 , fok_hl ),k_hl
c-debug; 1897    format(' KAPCOND: logKc_hl',f13.8,' dlogT,RHO',2f16.8,
c-debug;     $        ' fedge,ok',2f11.8,' k_hl',i3)
c-debug]
         if ( kdo_itoh .eq. 0 ) then
            flkb = flkh
            flkbt = flkht
            flkbro = flkhro
            flkc = flkh
            flkct = flkht
            flkcro = flkhro
            fedge_kc = max( 0.0 , fedge_hl )
            fkcedge = fedge_kc
            fedge_ok = max( 0.0 , fok_hl )
            fkcok = fedge_ok
            return
         endif
c
      endif
c
      if ( kdo_itoh .gt. 0 ) then
c
         xg = 0.45641 * gamma_ln - 1.31636
c					   ! if Gamma > 171, will extrapolate
c					   ! linearly in ln(Gamma), i.e., in xg
c					   ! (using the slope at Gamma = 171)
         if ( xg .le. xg_max ) then
            idat = idus
            delta_xg = 0.
         else
            idat = 2
            delta_xg = xg - xg_max
            xg = xg_max
         endif
c
         ratksqo4 = ratsqo4con / sqrt(rr_it)
         ratsqinva = 1. + 1. / ratksqo4
         ratsqinvb = 1. / ( ratksqo4 + 1. )
         fimrr = ( log(ratsqinva) - ratsqinvb ) * 0.5
         fimrs = 0.0896 * rs_it + 1.0028
         fim1 = fimrr * fimrs
         fip1 = ( 0.3429 * rs_it - 0.4573 ) * rs_it + 0.4893
         fip3 = 0.2484 - 0.0953 * rs_it
c-debug[
c-debug;         if ( i_debug_kcond .gt. 0 ) write(6,1735) fmuainv, fmuai,
c-debug;     $        fmueinv, fmuei, fmuei_ln, zsqbar, zsq,
c-debug;     $        rr_it, omrr, rs_it, y0_it, fim1, fip1, fip3
c-debug; 1735    format(' 1/muA',f9.6,' -->',f9.6,' 1/mue',f9.6,' -->',f9.6,
c-debug;     $        ' ln(1/mue)',f10.6,' <z^2>',f10.5,' -->',f10.5,
c-debug;     $        ' R,1-R,rs,y0',1p,4e15.7,' <Ij>',3e15.7)
c-debug]
c
         if ( idus .gt. 0 ) then
c
c_parameter;            dlnt_xg = -0.45641
c_parameter;            dlnro_xg = 0.45641 * f13
            dlnro_rs = fm13 * rs_it
            dlnt_y0 = - y0_it
            dlnro_y0 = f23 * y0_it
            dlnro_rr = f23 * rr_it * omrr
c
            dlnro_fim1 = 0.0896 * fimrr * dlnro_rs
     $           + fimrs * ratsqinvb**2 * f16 * omrr
            dlnro_fip1 = ( 0.6858 * rs_it - 0.4573 ) * dlnro_rs
            dlnro_fip3 = -0.0953 * dlnro_rs
c
c-debug[
c-debug;            if ( i_debug_kcond .gt. 1 ) write(6,1736) dlnt_y0*fln10,
c-debug;     $           dlnro_rr*fln10, -dlnro_rr*fln10, dlnro_rs*fln10,
c-debug;     $           dlnro_y0*fln10, dlnro_fim1*fln10, dlnro_fip1*fln10,
c-debug;     $           dlnro_fip3*fln10
c-debug; 1736       format('             dlgT_y0',1p,e15.7,
c-debug;     $           ' dlgRHO.....',1p,4e15.7,' ....',3e15.7)
c-debug]
         endif
c
         do i = 1, nitoh
c
            if ( xi_kc(i) .gt. 0.0 ) then
c
               do j = 1, 3
c
                  asum = ( ( ax_kc(3,i,j) * xg + ax_kc(2,i,j) ) * xg
     $                 + ax_kc(1,i,j) ) * xg + ax_kc(0,i,j)
                  bsum = ( bx_kc(2,i,j) * xg + bx_kc(1,i,j) ) * xg
     $                 + bx_kc(0,i,j)
                  csum = ( cx_kc(2,i,j) * xg + cx_kc(1,i,j) ) * xg
     $                 + cx_kc(0,i,j)
                  b_c_rs = ( csum * rs_it + bsum ) * rs_it + 1.
                  sj(j) = b_c_rs * asum
c
                  if ( idat .gt. 0 ) then
c
                     drs_b_c_rs = 2. * csum * rs_it + bsum
c
                     dxg_asum = ( 3. * ax_kc(3,i,j) * xg
     $                    + 2. * ax_kc(2,i,j) ) * xg + ax_kc(1,i,j)
                     dxg_bsum = 2. * bx_kc(2,i,j) * xg + bx_kc(1,i,j)
                     dxg_csum = 2. * cx_kc(2,i,j) * xg + cx_kc(1,i,j)
c
                     drs_sj(j) = asum * drs_b_c_rs
c
                     dxg_sj(j) = b_c_rs * dxg_asum
     $                    + asum * ( dxg_csum * rs_it
     $                    + dxg_bsum ) * rs_it
c							! if Gamma > 171, then
c					    ! extrapolate linearly in ln(Gamma)
                     if ( idat .gt. 1 ) then
                        sj(j) = sj(j) + dxg_sj(j) * delta_xg
                        drs_sj(j) = drs_sj(j)
     $                       + ( drs_b_c_rs * dxg_asum
     $                       + asum * ( 2. * dxg_csum * rs_it
     $                       + dxg_bsum ) ) * delta_xg
                     endif
c
                  endif
c
               enddo
c
               dy0_ska = ( sj(3) * rr_it - sj(2) ) * f23
     $              - ( sixopisq * rr_it + fouropisq23 ) * fip1
     $              + fouropisq23 * rr_it * fip3 + sixopisq * fim1
c
               ska = dy0_ska * y0_it
     $              + ( sj(1) - sj(2) * rr_it ) * ai_kc(i)
c
               if ( ska .gt. 1.e-35 ) then
c
                  f_xi = xi_kc(i) / ska
c
                  if ( idus .gt. 0 ) then
c
                     dxg_ska = ( dxg_sj(3) * rr_it - dxg_sj(2) )
     $                    * f23 * y0_it + ( dxg_sj(1)
     $                    - dxg_sj(2) * rr_it ) * ai_kc(i)
c
                     drs_ska = ( drs_sj(3) * rr_it - drs_sj(2) )
     $                    * f23 * y0_it + ( drs_sj(1)
     $                    - drs_sj(2) * rr_it ) * ai_kc(i)
c
                     drr_ska = y0_it * ( sj(3) * f23 - sixopisq * fip1
     $                    + fouropisq23 * fip3 ) - sj(2) * ai_kc(i)
c
                     dlnt_ska = dxg_ska * dlnt_xg + dy0_ska * dlnt_y0
c
                     dlnro_ska = dxg_ska * dlnro_xg
     $                    + drs_ska * dlnro_rs + drr_ska * dlnro_rr
     $                    + dy0_ska * dlnro_y0
     $                    + y0_it * (  fouropisq23 * rr_it * dlnro_fip3
     $                    - ( sixopisq * rr_it + fouropisq23 )
     $                    * dlnro_fip1 + sixopisq * dlnro_fim1  )
c
                     flkit = flkit + f_xi * ( dlnt_ska / ska )
                     flkiro = flkiro + f_xi * ( dlnro_ska / ska )
c
                  endif
c
                  flki = flki + f_xi
c
               else
c
                  flki = flki + xi_kc(i) * 1.e35
c
               endif
c-debug[
c-debug;               if ( i_debug_kcond .gt. 0 ) write(6,1739) i, xi_kc(i),
c-debug;     $              exp(gamma_ln), gamma_ln, xg, sj(1), sj(2), sj(3),
c-debug;     $              ska, ska/omrr, flki
c-debug; 1739          format(' KAPCOND: Xi(',i1,')',1p,e14.7,
c-debug;     $              ' Gamma',0p,f15.6,' lnGamma,xg',
c-debug;     $              0p,2f11.6,' <Sj>',3f16.8,' A<Sk>',f16.8,
c-debug;     $              ' A<Sk>/(1-R)',f16.8,' sum',f16.8)
c-debug;               if ( idus .gt. 0 .and. i_debug_kcond .gt. 1 ) then
c-debug;                  write(6,1738) '_xg', dxg_sj(1), dxg_sj(2),
c-debug;     $                 dxg_sj(3), '_xg', dxg_ska
c-debug;                  write(6,1738) '_rs', drs_sj(1), drs_sj(2),
c-debug;     $                 drs_sj(3), '_rs', drs_ska,
c-debug;     $                 ' d_rr:A<Sk>', drr_ska
c-debug;                  write(6,1738) 'lgt', ( dxg_sj(j) * dlnt_xg * fln10,
c-debug;     $                 j = 1, 3), 'lgt', dlnt_ska * fln10
c-debug;                  write(6,1738) 'lgr', ( dxg_sj(j) * dlnro_xg * fln10
c-debug;     $                 + drs_sj(j) * dlnro_rs * fln10, j = 1, 3),
c-debug;     $                 'lgr', dlnro_ska * fln10
c-debug; 1738             format(15x,14x,6x,15x,11x,
c-debug;     $                 22x,' d',a,3f16.8,'  d',a,f16.8,
c-debug;     $                 a,f16.8)
c-debug;               endif
c-debug]
c
            endif
c
         enddo
c
         fedge_it = min( fedge_it , fok_it )
c
         if ( flki .le. 0.0 .and. f_itoh .gt. 0.0 ) then
            flkb = badlogkval
            flkbt = 0.0
            flkbro = 0.0
            flkc = badlogkval
            flkct = 0.0
            flkcro = 0.0
            fedge_kc = -99.
            fkcedge = fedge_kc
            fedge_ok = -99.
            fkcok = fedge_ok
            return
         endif
c
         if ( idus .gt. 0 ) then
            flkit = flkit / flki + 2.
            flkiro = flkiro / flki - 2. + dlnro_rr / omrr
         endif
c
         flki = ( flt - flro ) * 2. - log10( omrr * flki )
     $        + flogitohcon
c
c-debug[
c-debug;         if ( i_debug_kcond .gt. 0 ) write(6,1749) flki,
c-debug;     $        flkit, flkiro, max( 0.0 , fedge_it ),
c-debug;     $        max( 0.0 , fok_it ), f_tf, f_gam, f_rs, f_yi
c-debug; 1749    format(' KAPCOND: logKc_It',f13.8,' dlogT,RHO',2f16.8,
c-debug;     $        ' fedge,ok',2f11.8,' ftf,gam,rs,yi',4f14.8)
c-debug]
         if ( kdo_hl .eq. 0 ) then
            flkb = flki
            flkbt = flkit
            flkbro = flkiro
            flkc = flki
            flkct = flkit
            flkcro = flkiro
            fedge_kc = max( 0. , min( fedge_it , fok_it ) )
            fkcedge = fedge_kc
            fedge_ok = max( 0. , fok_it )
            fkcok = fedge_ok
            return
         endif
c
      endif
c
      if ( idus .gt. 0 ) then
         flkbt = f_hl * flkht + f_itoh * flkit
     $        + dlogt_f_itoh * ( flki - flkh )
         flkbro = f_hl * flkhro + f_itoh * flkiro
     $        + dlogro_f_itoh * ( flki - flkh )
      endif
c
      flkb = f_hl * flkh + f_itoh * flki
c
      flkc = flkb
      flkct = flkbt
      flkcro = flkbro
c
      tmp = min( 1. , f_rshi , f_gamhi , f_yi )
      if ( f_rs .le. 0. ) then
         fedge_ok = max( 0. , min( tmp , fok_hl ) )
      else if ( flro .lt. 6. ) then
         fedge_ok = max( 0. , fok_it , min( tmp , fok_hl ) )
      else
         fedge_ok = max( 0. ,
     $        min( tmp , 1. - f_rho , ( 9.2 - flt ) * 5. ) ,
     $        min( tmp , f_rs ,
     $        max( ( 9.2 - flt ) * 5. , min( f_tf , f_gam ) ) ) )
      endif
      fkcok = fedge_ok
c
      fedge_kc = max( 0. , f_hl * fedge_hl + f_itoh * fedge_it )
      fkcedge = fedge_kc
c-debug[
c-debug;      if ( i_debug_kcond .gt. 0 ) write(6,1748) flkc, flkct, flkcro,
c-debug;     $     fkcedge, fkcok, f_hl, f_itoh, dlogt_f_itoh, dlogro_f_itoh,
c-debug;     $     f_rho, f_tf, f_gam, f_rs
c-debug; 1748 format(' KAPCOND: logKc',f16.8,' dlogT,RHO',2f16.8,
c-debug;     $     ' fedge,ok',2f11.8,' f_hl,It',2f12.8,' dT,R:f_It',2f16.8,
c-debug;     $     ' f_rho,tf,gam,rs',4f14.8)
c-debug]
      return
      end
c
c******************************************************************************
c
      subroutine kap_cond_pot( flro, flt, Zion, ider,
     $                         flkc, flkct, flkcro, fkcedge, fkcok )
c     ==============================================================
c
c  flro = log10(RHO), flt = log10(T), Zion = rms (or mean) ionic charge
c  ider = 1 : use bi-quadratic interpolation, with derivatives.
c         0 : use bi-quadratic interpolation, no derivatives.
c        -1 : use Potekhin website formulae, with derivatives.
c  RETURNS:
c    flkc = logKc = log10( Kappa_cond )
c    [if ider is not 0]: flkct = dlogKc / dlogT , flkcro = dlogKc / dlogRHO
c    fkcedge, fkcok  (strict and loose edge factors)
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nT_KcPot=19, nR_KcPot=64, nZ_KcPot=15 )
c
      parameter ( ntlokc=37, ntlokcm1=ntlokc-1, nthikc=90-ntlokcm1,
     $     nrlokc=-23, nrlokcm1=nrlokc-1, nrhikc=24-nrlokcm1, nkc=3,
     $     nthikcm1=nthikc-1, nrhikcm1=nrhikc-1, nkcp1=nkc+1 )
      parameter ( dlt_kc=.1, dlr_kc=.25, dltinv_kc=10., dlrinv_kc=4. )
c
      character*2 celkc_hl(nkc)
      common /c_flkcond_hlpot/ flkc_pot(nT_KcPot,nR_KcPot,nZ_KcPot),
     $     AT_pot(nT_KcPot), AR_pot(nR_KcPot), AZ_pot(nZ_KcPot),
     $     sigconlog_pot, itlo_hl(nrhikc,nkc), ithi_hl(nrhikc,nkc),
     $     irhi_hl(nkc), itlo_ok_hl(nrhikc,nkc),
     $     irjump_hl(nkc), celkc_hl
      save /c_flkcond_hlpot/
c
      dimension flkc_hl(nthikc,nrhikc,nkc),
     $     flrolo_hl(nkc), flrohi_hl(nkc),
     $     fltlo_hl(nkc), flthi_hl(nkc),
     $     flRlo_hl(nkc), flRhi_hl(nkc), kZ_pot(nZ_KcPot)
      equivalence (flkc_pot(1,1,1),flkc_hl(1,1,1)),
     $     (AR_pot(1),flrolo_hl(1)), (AR_pot(nkcp1),flrohi_hl(1)),
     $     (AT_pot(1),fltlo_hl(1)), (AT_pot(nkcp1),flthi_hl(1)),
     $     (AZ_pot(1),flRlo_hl(1)), (AZ_pot(nkcp1),flRhi_hl(1)),
     $     (itlo_hl(1,1),kZ_pot(1))
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
c  Note: these are initialized to valid values in BLOCK DATA OPAL_OPAC_DATA:
c
      common /c_pot_indices/ zkpot(0:3,0:3), zlg_pot_p, i1pot_p,
     $     i4pot_p, j1pot_p, j4pot_p, i1pot, i2pot, i3pot, i4pot,
     $     j1pot, j2pot, j3pot, j4pot, k1pot, k2pot, k3pot, k4pot
      save /c_pot_indices/
c
      common/d_opal_z/ dkap
      save /d_opal_z/
c
      parameter ( nTm1_KcPot=nT_KcPot-1, nRm1_KcPot=nR_KcPot-1,
     $     nTm2_KcPot=nT_KcPot-2, nRm2_KcPot=nR_KcPot-2,
     $     nZm1_KcPot=nZ_KcPot-1, badlogkval=1.e+35 )
c
      dimension h(0:3), dh(0:3)
c-debug[
c-debug;      common/outdeb/ ioudeb,oudebl,koudeb
c-debug]
c
      flkc = badlogkval
      flkct = 0.0
      flkcro = 0.0
      fkcedge = -99999.
      fkcok = -99999.
c					! Potekhin 2006 opacities unavailable ?
      if ( kavail_cond .le. 1 ) return
c							! unphysical Zion ?
      if ( Zion .le. 0.1 .or. Zion .gt. 130.0 ) then
         write(6,10) Zion
 10      format(' KAP_COND_POT Error: bad (unphysical)',
     $        ' value of Zion =',1p,e14.6)
         stop ' STOP -- KAP_COND_POT Error: bad value of Zion. '
      endif
c				! get log(Zion) for interpolation purposes
      zlg = log10( Zion )
c-debug[
c-debug;      if ( ioudeb .gt. 5 ) write(6,
c-debug;     $     '(/" ----- kap_cond_pot( flro",f11.6," flt",f10.6," Zion",
c-debug;     $     f11.6," ider",i3," ... ) ----- ZLG = log(Zion) =",f11.7)')
c-debug;     $     flro, flt, Zion, ider, zlg
c-debug]
c								! edge factors
      zflo = ( zlg - AZ_pot(1) ) / ( AZ_pot(2) - AZ_pot(1) ) 
      zfhi = ( AZ_pot(nZ_KcPot) - zlg )
     $     / ( AZ_pot(nZ_KcPot) - AZ_pot(nZm1_KcPot) )
c
      tflo = ( flt - AT_pot(1) ) / ( AT_pot(2) - AT_pot(1) )
      tfhi = ( AT_pot(nT_KcPot) - flt )
     $     / ( AT_pot(nT_KcPot) - AT_pot(nTm1_KcPot) )
c
      rflo = ( flro - AR_pot(1) ) / ( AR_pot(2) - AR_pot(1) )
      rfhi = ( AR_pot(nR_KcPot) - flro )
     $     / ( AR_pot(nR_KcPot) - AR_pot(nRm1_KcPot) )
c
      fkcok = 1.0 + min( 0.0 ,
     $     tflo , tfhi , rflo , rfhi , zflo , zfhi )
c
c  For the strictly valid region, edge factor  fedge_degen  goes 1.0 to 0.0
c  as one goes from (rather approximately)  eta = 4.4  to  eta = -2.6
c  as estimated from the figures 24.5 and 24.6 (p. 848 and 858) of Cox & Giuli
c  i.e. as one goes from degenerate to non-degenerate regions:
c
      f_lo = min( 4.842 + 0.6625 * flro , 5.524 + 0.5414 * flro ,
     $     6.336 + 0.4211 * flro )
      f_hi = f_lo + 1.25
      fedge_degen = min( 1.0 , ( f_hi - flt ) * 0.8 )
c
      fkcedge = min( fkcok , fedge_degen )
c-debug[
c-debug;      if ( ioudeb .gt. 8 ) write(6,
c-debug;     $     '(/8x,"zf{lo,hi}",2f11.6," t",2f11.6," r",2f11.6,
c-debug;     $     " fkcok",f11.6," logTdeg",2f10.6," fedge_degen",f11.6,
c-debug;     $     " fkcedge",f11.6)')
c-debug;     $     zflo, zfhi, tflo, tfhi, rflo, rfhi, fkcok,
c-debug;     $     f_lo, f_hi, fedge_degen, fkcedge
c-debug]
c								! T-indices
      imd = 1
      do while ( i2pot .gt. 1 .and. flt .lt. AT_pot(i2pot) )
         i3pot = i2pot
         i2pot = max( 1 , i2pot - imd )
         imd = imd + imd
      enddo
      do while ( i3pot .lt. nT_KcPot .and. flt .gt. AT_pot(i3pot) )
         i2pot = i3pot
         i3pot = min( nT_KcPot , i3pot + imd )
         imd = imd + imd
      enddo
      do while ( i3pot - i2pot .gt. 1 )
         imd = ( i2pot + i3pot ) / 2
         if ( flt .ge. AT_pot(imd) ) then
            i2pot = imd
         else
            i3pot = imd
         endif
      enddo
      if ( i2pot .eq. 1 ) then
         i1pot = 1
         if ( ider .ge. 0 .and. tflo .le. -1.0 ) then
            i4pot = 2
         else
            i4pot = 3
         endif
      else if ( i3pot .eq. nT_KcPot ) then
         i4pot = nT_KcPot
         if ( ider .ge. 0 .and. tfhi .le. -1.0 ) then
            i1pot = nTm1_KcPot
         else
            i1pot = nTm2_KcPot
         endif
      else
         i1pot = i2pot - 1
         i4pot = i3pot + 1
      endif
c								! RHO-indices
      imd = 1
      do while ( j2pot .gt. 1 .and. flro .lt. AR_pot(j2pot) )
         j3pot = j2pot
         j2pot = max( 1 , j2pot - imd )
         imd = imd + imd
      enddo
      do while ( j3pot .lt. nR_KcPot .and. flro .gt. AR_pot(j3pot) )
         j2pot = j3pot
         j3pot = min( nR_KcPot , j3pot + imd )
         imd = imd + imd
      enddo
      do while ( j3pot - j2pot .gt. 1 )
         imd = ( j2pot + j3pot ) / 2
         if ( flro .ge. AR_pot(imd) ) then
            j2pot = imd
         else
            j3pot = imd
         endif
      enddo
      if ( j2pot .eq. 1 ) then
         j1pot = 1
         if ( ider .ge. 0 .and. rflo .le. -1.0 ) then
            j4pot = 2
         else
            j4pot = 3
         endif
      else if ( j3pot .eq. nR_KcPot ) then
         j4pot = nR_KcPot
         if ( ider .ge. 0 .and. rfhi .le. -1.0 ) then
            j1pot = nRm1_KcPot
         else
            j1pot = nRm2_KcPot
         endif
      else
         j1pot = j2pot - 1
         j4pot = j3pot + 1
      endif
c								! Zion-indices
      imd = 1
      do while ( k2pot .gt. 1 .and. zlg .lt. AZ_pot(k2pot) )
         k3pot = k2pot
         k2pot = max( 1 , k2pot - imd )
         imd = imd + imd
      enddo
      do while ( k3pot .lt. nZ_KcPot .and. zlg .gt. AZ_pot(k3pot) )
         k2pot = k3pot
         k3pot = min( nZ_KcPot , k3pot + imd )
         imd = imd + imd
      enddo
      do while ( k3pot - k2pot .gt. 1 )
         imd = ( k2pot + k3pot ) / 2
         if ( zlg .ge. AZ_pot(imd) ) then
            k2pot = imd
         else
            k3pot = imd
         endif
      enddo
c
c  If we should use bi-quadratic interpolation (rather than cubic):
c
      if ( ider .ge. 0 ) then
c
         dtk = 0.0
         drk = 0.0
c
         need_z = 1
c							      ! no Zion-interp?
         if ( i1pot .eq. i1pot_p .and. j1pot .eq. j1pot_p .and.
     $        i4pot .le. i4pot_p .and. j4pot .le. j4pot_p .and.
     $        abs( zlg - zlg_pot_p ) .lt. small_1m6 ) then
c
c-debug[
c-debug;            if ( ioudeb .gt. 5 ) write(6,
c-debug;     $           '(/8x,"logRHO",4i3,f10.6," :",f10.6,
c-debug;     $           "  logT",4i3,f9.6," :",f9.6,
c-debug;     $           "  logZion",f11.7," = logZion_p",f11.7)')
c-debug;     $           j1pot, j2pot, j3pot, j4pot,
c-debug;     $           AR_pot(j1pot), AR_pot(j4pot),
c-debug;     $           i1pot, i2pot, i3pot, i4pot,
c-debug;     $           AT_pot(i1pot), AT_pot(i4pot),
c-debug;     $           zlg, zlg_pot_p
c-debug]
            need_z = 0
c
         else if ( abs( AZ_pot(k2pot) - zlg ) .lt. small_1m6 ) then
c
c-debug[
c-debug;            if ( ioudeb .gt. 5 ) write(6,
c-debug;     $           '(/8x,"logRHO",4i3,f10.6," :",f10.6,
c-debug;     $           "  logT",4i3,f9.6," :",f9.6,
c-debug;     $           "  logZion @ k2pot=",i3,f10.6)')
c-debug;     $           j1pot, j2pot, j3pot, j4pot,
c-debug;     $           AR_pot(j1pot), AR_pot(j4pot),
c-debug;     $           i1pot, i2pot, i3pot, i4pot,
c-debug;     $           AT_pot(i1pot), AT_pot(i4pot),
c-debug;     $           k2pot, AZ_pot(k2pot)
c-debug]
            zlg_pot_p = AZ_pot(k2pot)
c
            do it = i1pot, i4pot
               kt = it - i1pot
               do jr = j1pot, j4pot
                  kr = jr - j1pot
                  zkpot(kr,kt) = flkc_pot(it,jr,k2pot)
               enddo
            enddo
c
         else if ( abs( AZ_pot(k3pot) - zlg ) .lt. small_1m6 ) then
c
c-debug[
c-debug;            if ( ioudeb .gt. 5 ) write(6,
c-debug;     $           '(/8x,"logRHO",4i3,f10.6," :",f10.6,
c-debug;     $           "  logT",4i3,f9.6," :",f9.6,
c-debug;     $           "  logZion @ k3pot=",i3,f10.6)')
c-debug;     $           j1pot, j2pot, j3pot, j4pot,
c-debug;     $           AR_pot(j1pot), AR_pot(j4pot),
c-debug;     $           i1pot, i2pot, i3pot, i4pot,
c-debug;     $           AT_pot(i1pot), AT_pot(i4pot),
c-debug;     $           k3pot, AZ_pot(k3pot)
c-debug]
            zlg_pot_p = AZ_pot(k3pot)
c
            do it = i1pot, i4pot
               kt = it - i1pot
               do jr = j1pot, j4pot
                  kr = jr - j1pot
                  zkpot(kr,kt) = flkc_pot(it,jr,k3pot)
               enddo
            enddo
c					! else: Zion-interpolation is needed:
         else
c
            zlg_pot_p = zlg
c
            k1pot = max( 1 , k2pot - 1 )
            k4pot = min( nZ_KcPot , k3pot + 1 )
c
            imd = k4pot - k1pot
            k2use = k1pot + 1
            k3use = min( nZ_KcPot , k1pot + 2 )
c-debug[
c-debug;            if ( ioudeb .gt. 6 ) write(6,
c-debug;     $           '(8x,"logRHO",4i3,f10.6," :",f10.6,
c-debug;     $           "  logT",4i3,f9.6," :",f9.6,
c-debug;     $           "  logZion",4i3," -->(nmore=",i1,")",4i3,4f10.6)')
c-debug;     $           j1pot, j2pot, j3pot, j4pot,
c-debug;     $           AR_pot(j1pot), AR_pot(j4pot),
c-debug;     $           i1pot, i2pot, i3pot, i4pot,
c-debug;     $           AT_pot(i1pot), AT_pot(i4pot),
c-debug;     $           k1pot, k2pot, k3pot, k4pot,
c-debug;     $           imd, k1pot, k2use, k3use, k4pot,
c-debug;     $           ( AZ_pot(i), i = k1pot, k4pot )
c-debug;            if ( ioudeb .gt. 8 ) write(6,'("")')
c-debug]
c
            call quadNsto( 1, imd, zlg, AZ_pot(k1pot), AZ_pot(k2use),
     $                     AZ_pot(k3use), AZ_pot(k4pot) )

            do it = i1pot, i4pot
               kt = it - i1pot
               do jr = j1pot, j4pot
                  zkpot(jr-j1pot,kt) =
     $                 quadNget( 1, imd, flkc_pot(it,jr,k1pot),
     $                 flkc_pot(it,jr,k2use),
     $                 flkc_pot(it,jr,k3use),
     $                 flkc_pot(it,jr,k4pot) )
c-debug[
c-debug;                  if ( ioudeb .gt. 8 ) write(6,
c-debug;     $                 '(12x,"zkpot(",i1,",",i1,") =",
c-debug;     $                 f11.6," <--",4f11.6)')
c-debug;     $                 jr - j1pot, kt, zkpot(jr-j1pot,kt),
c-debug;     $                 ( flkc_pot(it,jr,i), i = k1pot, k4pot )
c-debug]
               enddo
            enddo
c
         endif
c				    ! finished Zion-interpolation; save cache
         if ( need_z .ne. 0 ) then
            i1pot_p = i1pot
            i4pot_p = i4pot
            j1pot_p = j1pot
            j4pot_p = j4pot
         endif
c				! do RHO-interpolation:
         ihi = i4pot - i1pot
c
c-debug[
c-debug;         if ( ioudeb .gt. 7 ) write(6,'("")')
c-debug]
         j2use = j1pot + 1
         j3use = min( j1pot + 2 , j4pot )
         imd = j4pot - j1pot
c					! if no derivatives:
         if ( ider .eq. 0 ) then
c
            call quadNsto( 1, imd, flro, AR_pot(j1pot), AR_pot(j2use),
     $                     AR_pot(j3use), AR_pot(j4pot) )
c
            do kt = 0, ihi
               h(kt) = quadNget( 1, imd, zkpot(0,kt), zkpot(1,kt),
     $                           zkpot(2,kt), zkpot(3,kt) )
c-debug[
c-debug;               if ( ioudeb .gt. 7 ) write(6,
c-debug;     $              '(10x,"h(",i1,") =",f11.6," <--",4f11.6)')
c-debug;     $              kt, h(kt), ( zkpot(i,kt), i = 0, imd )
c-debug]
            enddo
c					! else: with derivatives:
         else
c
            call qderNsto( 1, imd, flro, AR_pot(j1pot), AR_pot(j2use),
     $                     AR_pot(j3use), AR_pot(j4pot) )
c
            do kt = 0, ihi
               call qderNget( 1, imd, zkpot(0,kt), zkpot(1,kt),
     $                        zkpot(2,kt), zkpot(3,kt), h(kt), dh(kt) )
c-debug[
c-debug;               if ( ioudeb .gt. 7 ) write(6,
c-debug;     $              '(10x,"h,dh(",i1,") =",2f11.6," <--",4f11.6)')
c-debug;     $              kt, h(kt), dh(kt), ( zkpot(i,kt), i = 0, imd )
c-debug]
            enddo
c
         endif
c			    ! finished RHO-interpolation; do T-interpolation:
         i2use = i1pot + 1
         i3use = min( i1pot + 2 , i4pot )
         imd = i4pot - i1pot
c					! if no derivatives:
         if ( ider .eq. 0 ) then
c
            call quadNsto( 1, imd, flt, AT_pot(i1pot), AT_pot(i2use),
     $                     AT_pot(i3use), AT_pot(i4pot) )
c
            ck = quadNget( 1, imd, h(0), h(1), h(2), h(3) )
c-debug[
c-debug;            if ( ioudeb .gt. 6 ) then
c-debug;               write(6,'(/8x,"ck =",f11.6," <--",4f11.6)')
c-debug;     $              ck, ( h(i), i = 0, imd )
c-debug;               write(6,'("")')
c-debug;            endif
c-debug]
c					! else: with derivatives:
         else
c
            call qderNsto( 1, imd, flt, AT_pot(i1pot), AT_pot(i2use),
     $                     AT_pot(i3use), AT_pot(i4pot) )
c
            call qderNget( 1, imd, h(0), h(1), h(2), h(3), ck, dtk )
c
            drk = quadNget( 1, imd, dh(0), dh(1), dh(2), dh(3) )
c-debug[
c-debug;            if ( ioudeb .gt. 6 ) then
c-debug;               write(6,'(/8x,"ck,dtk =",2f11.6," <--",4f11.6)')
c-debug;     $              ck, dtk, ( h(i), i = 0, imd )
c-debug;               write(6,'(8x,"   drk =",f22.6," <--",4f11.6)')
c-debug;     $              drk, ( dh(i), i = 0, imd )
c-debug;               write(6,'("")')
c-debug;            endif
c-debug]
c
         endif
c
c  Alternatively: use cubic formulae from Potekhin-website program condint.f :
c
      else
c
c Cubic interpolation in RLG:
c Z0:
         call sngl_cinterp3( AR_pot(j1pot), AR_pot(j2pot),
     $        AR_pot(j3pot), AR_pot(j4pot), flro, j2pot, nR_KcPot,
     $        flkc_pot(i1pot,j1pot,k2pot), flkc_pot(i1pot,j2pot,k2pot),
     $        flkc_pot(i1pot,j3pot,k2pot), flkc_pot(i1pot,j4pot,k2pot),
     $        CKTMZ0, DRKTMZ0, DR2KTMZ0, XR )
         call sngl_cinterp3( AR_pot(j1pot), AR_pot(j2pot),
     $        AR_pot(j3pot), AR_pot(j4pot), flro, j2pot, nR_KcPot,
     $        flkc_pot(i2pot,j1pot,k2pot), flkc_pot(i2pot,j2pot,k2pot),
     $        flkc_pot(i2pot,j3pot,k2pot), flkc_pot(i2pot,j4pot,k2pot),
     $        CKT0Z0, DRKT0Z0, DR2KT0Z0, XR )
         call sngl_cinterp3( AR_pot(j1pot), AR_pot(j2pot),
     $        AR_pot(j3pot), AR_pot(j4pot), flro, j2pot, nR_KcPot,
     $        flkc_pot(i3pot,j1pot,k2pot), flkc_pot(i3pot,j2pot,k2pot),
     $        flkc_pot(i3pot,j3pot,k2pot), flkc_pot(i3pot,j4pot,k2pot),
     $        CKT1Z0, DRKT1Z0, DR2KT1Z0, XR )
         call sngl_cinterp3( AR_pot(j1pot), AR_pot(j2pot),
     $        AR_pot(j3pot), AR_pot(j4pot), flro, j2pot, nR_KcPot,
     $        flkc_pot(i4pot,j1pot,k2pot), flkc_pot(i4pot,j2pot,k2pot),
     $        flkc_pot(i4pot,j3pot,k2pot), flkc_pot(i4pot,j4pot,k2pot),
     $        CKTPZ0, DRKTPZ0, DR2KTPZ0, XR )
c Z1:
         call sngl_cinterp3( AR_pot(j1pot), AR_pot(j2pot),
     $        AR_pot(j3pot), AR_pot(j4pot), flro, j2pot, nR_KcPot,
     $        flkc_pot(i1pot,j1pot,k3pot), flkc_pot(i1pot,j2pot,k3pot),
     $        flkc_pot(i1pot,j3pot,k3pot), flkc_pot(i1pot,j4pot,k3pot),
     $        CKTMZ1, DRKTMZ1, DR2KTMZ1, XR )
         call sngl_cinterp3( AR_pot(j1pot), AR_pot(j2pot),
     $        AR_pot(j3pot), AR_pot(j4pot), flro, j2pot, nR_KcPot,
     $        flkc_pot(i2pot,j1pot,k3pot), flkc_pot(i2pot,j2pot,k3pot),
     $        flkc_pot(i2pot,j3pot,k3pot), flkc_pot(i2pot,j4pot,k3pot),
     $        CKT0Z1, DRKT0Z1, DR2KT0Z1, XR )
         call sngl_cinterp3( AR_pot(j1pot), AR_pot(j2pot),
     $        AR_pot(j3pot), AR_pot(j4pot), flro, j2pot, nR_KcPot,
     $        flkc_pot(i3pot,j1pot,k3pot), flkc_pot(i3pot,j2pot,k3pot),
     $        flkc_pot(i3pot,j3pot,k3pot), flkc_pot(i3pot,j4pot,k3pot),
     $        CKT1Z1, DRKT1Z1, DR2KT1Z1, XR )
         call sngl_cinterp3( AR_pot(j1pot), AR_pot(j2pot),
     $        AR_pot(j3pot), AR_pot(j4pot), flro, j2pot, nR_KcPot,
     $        flkc_pot(i4pot,j1pot,k3pot), flkc_pot(i4pot,j2pot,k3pot),
     $        flkc_pot(i4pot,j3pot,k3pot), flkc_pot(i4pot,j4pot,k3pot),
     $        CKTPZ1, DRKTPZ1, DR2KTPZ1, XR )
c Linear interpolation in ZLG:
         XZ1 = (zlg-AZ_pot(k2pot))/(AZ_pot(k3pot)-AZ_pot(k2pot))
         XZ0 = 1.-XZ1
         CKTM = XZ0*CKTMZ0+XZ1*CKTMZ1
         DRKTM = XZ0*DRKTMZ0+XZ1*DRKTMZ1
         DR2KTM = XZ0*DR2KTMZ0+XZ1*DR2KTMZ1
         CKT0 = XZ0*CKT0Z0+XZ1*CKT0Z1
         DRKT0 = XZ0*DRKT0Z0+XZ1*DRKT0Z1
         DR2KT0 = XZ0*DR2KT0Z0+XZ1*DR2KT0Z1
         CKT1 = XZ0*CKT1Z0+XZ1*CKT1Z1
         DRKT1 = XZ0*DRKT1Z0+XZ1*DRKT1Z1
         DR2KT1 = XZ0*DR2KT1Z0+XZ1*DR2KT1Z1
         CKTP = XZ0*CKTPZ0+XZ1*CKTPZ1
         DRKTP = XZ0*DRKTPZ0+XZ1*DRKTPZ1
         DR2KTP = XZ0*DR2KTPZ0+XZ1*DR2KTPZ1
c Cubic interpolation in TLG:
c
c ! input: values of lg k where k is thermal conductivity
         call sngl_cinterp3( AT_pot(i1pot), AT_pot(i2pot),
     $        AT_pot(i3pot), AT_pot(i4pot), flt, i2pot, nT_KcPot,
     $        CKTM, CKT0, CKT1, CKTP,
     $        CK, DTK, DT2K, XT )
c   ! lg k, d lg k / d lg T, d2 lg k / d2 lg T
c
c ! input: values of d lg k / d lg rho
         call sngl_cinterp3( AT_pot(i1pot), AT_pot(i2pot),
     $        AT_pot(i3pot), AT_pot(i4pot), flt, i2pot, nT_KcPot,
     $        DRKTM, DRKT0, DRKT1, DRKTP,
     $        DRK, DRTK, DRT2K, XT )
c ! d lg k / d lg rho, d2 lgk/(d lgT d lg rho), ...
c
      endif
c			! convert thermal conductivity to conductive opacity:
c
      flkc = sigconlog_pot + 3.0 * flt - flro - ck
c
      if ( ider .ne. 0 ) then
         flkct = 3.0 - dtk
         flkcro = -1.0 - drk
      endif
c-debug[
c-debug;      if ( ioudeb .gt. 5 ) write(6,
c-debug;     $     '(" --END kap_cond_pot( ... RETURN flkc",f11.6,
c-debug;     $     " flkct",f11.6," flkcro",f11.6," fkcedge",f11.6,
c-debug;     $     " fkcok",f11.7," )"/)')
c-debug;     $     flkc, flkct, flkcro, fkcedge, fkcok
c-debug]
c
      return
      end
c
c******************************************************************************
c
      subroutine opal_k_only(z,xh,exC,exO,slt,slr,fcn,fcon,fcnone,fu)
c     ===============================================================
c
c..... The purpose of this subroutine is to interpolate log kappa
c          (and obtain smooth derivatives)
c      in hydrogen (if X>0) and in C/O abundance and T6, R, i.e. (X,Xc,Xo,T6,R)
c      Interpolation in CNO abundances is allowed by user-specified fractions.
c
c      z = Z = metallicity (this should always be the same)
c      xh = X = hydrogen mass fraction
c      exC = Xc = carbon mass fraction (excess over what is in Z)
c      exO = Xo = oxygen mass fraction (excess over what is in Z)
c      slt = logT6 = Log10{temperature in millions of degrees kelvin}
c      slr = logR = Log10{density(g/cm**3)/T6**3}
c      fcn = fraction to be applied of opacity shift from standard composition
c              to a composition with most or all of C converted to N
c      fcon = fraction to be applied of opacity shift from standard composition
c               to a composition with most or all of C and O converted to N
c      fcnone = fraction to be applied of the opacity shift from the standard
c                 composition to a composition with all C,N,O converted to Ne
c      fu = fraction to be applied of opacity shift from standard composition
c             to the composition of the user-specified opacity file
c
c..... to use OPAL_F_CNOU, insert common/e_opal_z/ in the calling routine.
c      This common contains interpolated values for log kappa and its 
c      first derivatives, and "out-of-table" indicators fedge,ftredge,fzedge.
c
c
      parameter ( small_1m6=1.e-6, small_m1m6=-1.e-6, small_9m7=9.e-7 )
c
      parameter ( small_m1m8=-1.e-8, one_p_small_1m6=1.0+small_1m6 )
c
      parameter ( small_1m8=1.e-8 )
c
c PARAMETERS to specify opacity storage matrices: see BLOCK DATA OPAL_OPAC_DATA
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
c PARAMETERS nrdel, ntdel give matrix position differences: see OPAL_OPAC_DATA
c
      parameter ( nrdel=nrb-1, ntdel=ntb-1 )
c
c PARAMETERS: offsets for Z, for X, min low-T X offset: see OPAL_OPAC_DATA
c
      parameter ( zdel=0.001, xdel=0.03, xdelmin=0.001 )
c
c PARAMETERS: for use in call to READZEXCO, if it is called from here in OPAL:
c  k_hz = 1 = khighz value for READZEXCO ("use 'GN93hz' in Z-interpolation,
c               but no CNO-interpolation")
c  ofe_brack = 0.0 = [O/Fe] value for READZEXCO
c
      parameter ( k_hz=1, ofe_brack=0.0 )
c
c PARAMETER badlogkval = 1.e+35 is stored to indicate missing Log(kappa) values
c
      parameter ( badlogkval=1.e+35, badlogklim=20. )
c
c PARAMETERS used when at high-T or -RHO boundary of opacity storage matrices
c
      parameter ( ntm_m3=ntm-3, nt_m2=nt-2, nr_m2=nr-2 )
c
c PARAMETERS used to specify logT6 and logR tabulation values
c
      parameter ( k81=nt-3, k80=k81-1, k60=k81-21, ks59=k60-1+ntdel )
      parameter ( flt81m6=8.1-6., flt60m6=6.0-6., flt370m6=3.70-6. )
      parameter ( flrmid = -3.0 )
c
c PARAMETERS defining the storage for the additional X-values from 'GN93hz':
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mx_hi_nz=mx_hi*nz )
c
c COMMON /xhi_opal_z/ : auxiliary matrices for additional 'GN93hz' X-values:
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
c COMMON /a_opal_z/ : matrices for opacity storage: see OPAL_OPAC_DATA
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
c COMMON /a_co_opal_z/ : matrices for opacity storage: see OPAL_OPAC_DATA
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
c COMMON /b_opal_z/ : high and low T-limits, Z-values: see OPAL_OPAC_DATA
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
c COMMON /bb_opal_z/ : some indices & abundances for T6,R and C,O interpolation
c
      common/bb_opal_z/ xodp,xcdp,xxco,cxx,oxx,
     $     l1,l2,l3,l4,k1,k2,k3,k4,ip,iq(4),kzf,kzg,kzh,kzf2
      save /bb_opal_z/
c
c COMMON /recoin_opal_z/ : see OPAL_OPAC_DATA
c
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c
c COMMON /c_opal_ctrl_smooth/ : flags to control the smoothing:
c
      common/c_opal_ctrl_smooth/ init_smo, low_CO_smo, interp_CO_smo
      save /c_opal_ctrl_smooth/
c
c COMMON /c_level_err_opal_z/  error-checking level, set by SET_ERR_CHECK
c
c /c_level_err_opal_z/: --> data{level_err}
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
c COMMON /E_OPAL_Z/ : Return variables : see also instructions above
c
c.... OPACT - opacity obtained from a quadratic interpolation at fixed
c      log T6 at three values of log R; followed by quadratic interpolation
c      along log T6.  Results smoothed by mixing overlapping quadratics.
c.... DOPACT - is Dlog(k)/Dlog(T6) at constant R smoothed by mixing quadratics.
c.... DOPACR - is  Dlog(k)/Dlog(R) at constant T smoothed by mixing quadratics.
c.... DOPACTD - is Dlog(k)/Dlog(T6) at constant rho.
c.... FEDGE = 1.0 inside T6,R,Z boundaries, goes to zero when too far outside
c      for extrapolation (in which case opacity is not calculated).
c.... FTREDGE = 1.0 inside T,R boundaries, goes to zero when too far outside.
c.... FZEDGE = 1.0 inside Z limits, goes to zero when too far outside.
c
      common /e_opal_z/ opvals(4),fedge,ftredge,fzedge
      save /e_opal_z/
      equivalence (opvals(1),opact), (opvals(2),dopact),
     $     (opvals(3),dopacr), (opvals(4),dopactd)
c
c  Stored values of input parameters for this routine, in case it was called
c  from another interface
c
      common /x_opal_z/ z_opal, x_opal, xc_opal, xo_opal, slt_opal,
     $     slr_opal, fcn_opal, fcon_opal, fcnone_opal, fu_opal
      save /x_opal_z/
c
      common /tredges_opal_z/ ftlo_edge, fthi_edge, frlo_edge,
     $     frhi_edge, ftcut_edge, frcut_edge, ftr_cut_edge
      save /tredges_opal_z/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
c PARAMETERS to specify lowest logR-limit for conductive opacities
c
      parameter ( rcondswlo = -6.0, rcondswdel = 0.5 )
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
c-debug[
c-debug;      common/outdeb/ ioudeb,oudebl,koudeb
c-debug;      dimension opv_prev(4)
c-debug]
c-test-xdel[              ! test various xdel values in opacity X-interpolation
c-test-xdel;
c-test-xdel;      parameter ( n_xdel_test=9, n_xdel_test_m1=n_xdel_test-1 )
c-test-xdel;      common/otherxdel/ opdxi(n_xdel_test),xdel_test(n_xdel_test)
c-test-xdel;      equivalence (opdxi(1),opdx001), (opdxi(2),opdx002),
c-test-xdel;     $      (opdxi(3),opdx0035), (opdxi(4),opdx005),
c-test-xdel;     $      (opdxi(5),opdx0075), (opdxi(6),opdx01),
c-test-xdel;     $      (opdxi(7),opdx02), (opdxi(n_xdel_test_m1),opdx03),
c-test-xdel;     $      (opdxi(n_xdel_test),opdxuse)
c-test-xdel;      data xdel_test/.001,.002,.0035,.005,.0075,.01,.02,.03,.03/
c-test-xdel]
c___
      dimension iqx(4),ntaxat(0:nrm)
c===					! we have not yet gotten a good opacity
      opact = badlogkval
      fedge = 0.0
      ftredge = 1.0
      fzedge = 1.0
c
      ftlo_edge = 1.0
      fthi_edge = 1.0
      frlo_edge = 1.0
      frhi_edge = 1.0
      ftcut_edge = 1.0
      frcut_edge = 1.0
      ftr_cut_edge = 1.0
c
      z_opal = z
      x_opal = xh
      xc_opal = exC
      xo_opal = exO
      slt_opal = slt
      slr_opal = slr
c
c..... set-up C/O axis points: making exC & exO arguments of OPAL is simpler
c      than resetting xxc & xxo after changing them, and also avoids an error
c      if constants are used for these values in the calling program.
c
      xxc = exC
      xxo = exO
      xxco = xxc + xxo
      if ( z + xh + xxco .gt. one_p_small_1m6 .or.
     $     z .lt. small_m1m8 .or.
     $     min(xh,xxc+z,xxo+z,xxco+z) .le. small_m1m6 ) then
         write(6,4397) z,xh,xxc,xxo
 4397    format(' '/' OPAL Error: bad Z',1p,e13.6,' X',e13.6,
     $        ' C',e13.6,' O',e13.6)
         stop ' STOP -- OPAL Error: bad composition value(s). '
      endif
      z_opal = max( z_opal , 0.0 )
c
c..... set X indices: if xh = a table X-value, then only use that X-table:
c
      if ( abs( xh - xa(1) ) .lt. small_9m7 ) then
         mf = 1
         mg = 1
         mh = 1
         mf2 = 1
         x_opal = xa(1)
      else if ( mx .eq. 1 ) then
         write(6,4396) xh,xa(1)
 4396    format(' '/' OPAL: mx=1, but X=',f10.7,
     $        ' differs from table value',f10.7)
         stop ' STOP -- OPAL Error: mx=1, but X differs from X_stored '
c		    ! else: find X-indices: results in ihi=5 (for xh > 0.35) or
c		    !        ihi=4 (for xh > 0.1) or ihi=3 (for xh < or = 0.1):
      else
         ilo = 2
         ihi = mx
         do while( ihi-ilo .gt. 1 )
            imd = (ihi+ilo)/2
            if ( xh .le. xa(imd) ) then
               ihi = imd
            else
               ilo = imd
            endif
         enddo
c						    ! if xh = a table X-value
         if ( abs( xh - xa(ilo) ) .lt. small_9m7 ) then
            mf = ilo
            mg = ilo
            mh = ilo
            mf2 = ilo
            x_opal = xa(ilo)
         else if ( abs( xh - xa(ihi) ) .lt. small_9m7 ) then
            mf = ihi
            mg = ihi
            mh = ihi
            mf2 = ihi
            x_opal = xa(ihi)
c				! else: will need to interpolate
         else
            mf = ilo - 1
            mg = ilo
            mh = ihi
            if ( xh .le. xa(2) ) then
               mf2 = mh
            else
               mf2 = min( ihi + 1 , mx )
            endif
         endif
      endif
c
c..... If necessary, read data files and do initializations, using READZEXCO
c
      if ( itime .ne. 12345678 )
     $     call readzexco(nz,-1.,z,-1.,k_hz,-1,ofe_brack)
c
c  If X > 0.03 and C+O is not too large, then the more-numerous X-values from
c  'GN93hz' can help, if use-flag is set: set f_xhi for later use.  Only used
c  if [ ( kdo_xhi = 1 and X > .7 ) or ( kdo_xhi = 2 and X > .03 ) ] and we are
c  not sitting on an X-grid-position and C+O < 0.3; these FULL opacity shifts
c  are only used if C+O < 0.2, a fraction of them is used for 0.2 < C+O < 0.3:
c
      if ( kdo_xhi .le. 0 .or. mf2 .lt. 4 .or. mf .eq. mf2 .or.
     $     ( kdo_xhi .eq. 1 .and. xh .le. xa(mx) ) .or.
     $     exC + exO .ge. 0.3 ) then
         f_xhi = 0.0
      else if ( exC + exO .le. 0.2 ) then
         f_xhi = 1.0
      else if ( exC + exO .lt. 0.25 ) then
         f_xhi = 1. - 200. * max( exC + exO - 0.2 , 0.0 )**2
      else
         f_xhi = 200. * ( 0.3 - ( exC + exO ) )**2
      endif
c
c  Check whether CNO- and/or user-interpolation will be needed
c
      if ( z .lt. small_1m8 ) then
c
         need_cno = 0
         need_user = 0
c
      else
c
         if ( kdo_cno .gt. 0 .and. max( abs(fcn) ,
     $        abs(fcon) , abs(fcnone) ) .gt. small_1m8 ) then
            need_cno = 1
         else
            need_cno = 0
         endif
c
         if ( kdo_user .gt. 0 .and. abs(fu) .gt. small_1m8 ) then
            need_user = 1
         else
            need_user = 0
         endif
c
      endif
c
      fcn_opal = fcn * need_cno
      fcon_opal = fcon * need_cno
      fcnone_opal = fcnone * need_cno
      fu_opal = fu * need_user
c
c..... set Z indices
c							! is Z out of range?
      if ( z .le. zlo_ex .or. z .ge. zhi_ex ) then
         fzedge = 0.0
         if ( level_err .ge. 2 ) then
            write(6,10) z, zlo_ex, zhi_ex
 10         format(' '/' OPAL: Z=',f11.8,
     $           ' is outside max extrap range (',f11.8,',',f10.8,')')
            stop ' STOP -- OPAL Error: bad Z value. '
         endif
         return
      endif
c							! check Z-extrapolation
      if ( z .lt. zlow ) then
         fzedge = max( 0.0 , ( z - zlo_ex ) / ( zlow - zlo_ex ) )
      else if ( z .gt. zhigh ) then
         fzedge = max( 0.0 , ( zhi_ex - z ) / ( zhi_ex - zhigh ) )
      else
         fzedge = 1.
      endif
c				   ! this shouldn't happen, but just in case...
      if ( fzedge .le. 0. ) then
         if ( level_err .ge. 2 ) then
            write(6,10) z, zlo_ex, zhi_ex
            stop ' STOP -- OPAL Error: bad Z value. '
         endif
         return
      endif
c						! check for Z-table value:
      if ( numz .eq. 1 ) then
         ihi = 1
      else
         ihi = 0
         if ( numz .le. 3 ) then
            do i = 1, numz
               if ( abs( zsto(i) - z ) .le. zacc(i) ) ihi = i
            enddo
         else if ( abs( zsto(kzg) - z ) .le. zacc(kzg) ) then
            ihi = kzg
         else if ( abs( zsto(1) - z ) .le. zacc(1) ) then
            ihi = 1
         endif
      endif
c						! get Z-table indices:
      if ( ihi .gt. 0 ) then
c
         kzf = ihi
         kzg = ihi
         kzh = ihi
         kzf2 = ihi
         z_opal = zsto(ihi)
c
      else if ( numz .le. 3 ) then
c
         kzf = 1
         kzg = 2
         kzh = numz
         kzf2 = numz
c
      else
c
         ihi = max( 3 , min( numz , kzh ) )
         ilo = ihi - 1
         imd = 1
         do while ( ilo .gt. 2 .and. z .lt. zsto(ilo) )
            ihi = ilo
            ilo = max( ilo - imd , 2 )
            imd = imd + imd
         enddo
         do while ( ihi .lt. numz .and. z .gt. zsto(ihi) )
            ilo = ihi
            ihi = min( numz , ihi + imd )
            imd = imd + imd
         enddo
c
         do while( ihi - ilo .gt. 1 )
            imd = (ihi+ilo)/2
            if ( z .le. zsto(imd) ) then
               ihi = imd
            else
               ilo = imd
            endif
         enddo
c
         if ( abs( zsto(ihi) - z ) .le. zacc(ihi) ) then
            kzf = ihi
            kzg = ihi
            kzh = ihi
            kzf2 = ihi
         else if ( abs( zsto(ilo) - z ) .le. zacc(ilo) ) then
            kzf = ilo
            kzg = ilo
            kzh = ilo
            kzf2 = ilo
         else
            kzf = ilo - 1
            kzg = ilo
            kzh = ihi
            if ( z .le. zsto(2) ) then
               kzf2 = kzh
            else
               kzf2 = min( ihi + 1 , numz )
            endif
         endif
c
      endif
c		! note that xxh is not used (except perhaps in calling routine)
      xxh = xh
c							     ! check T-R edges:
      frlo_edge = min( slr - slrlo , 0.0 ) * dlrlo_inv + 1.0
      frhi_edge = min( slrhi - slr , 0.0 ) * dlrhi_inv + 1.0
      ftlo_edge = min( slt - sltlo , 0.0 ) * dltlo_inv + 1.0
      fthi_edge = min( slthi - slt , 0.0 ) * dlthi_inv + 1.0
c
      ftredge = max( 0.0 ,
     $     min( frlo_edge , frhi_edge , ftlo_edge , fthi_edge ) )
c
      fedge = max( 0.0 , ftredge * fzedge )
c
      flrho = slr + slt * 3.0
c							     ! if far outside,
      if ( frlo_edge .le. 0.0 .or. ftlo_edge .le. 0.0 ) then
c							    ! return at low T,R
         if ( kdo_alex .le. 0 .and. level_err .ge. 2 ) then
            write(6,20) slt+6., slr, flrho
 20         format(' '/' OPAL: logT=',f9.6,', logR=',f11.6,
     $           ' [logRHO=',f11.6,']: beyond matrix edge')
            stop ' STOP -- OPAL Error: bad T or R value. '
         endif
         return
c					! but return at high T,R only if NOT in
      else if ( ftredge .le. 0.0 ) then
c					  ! region where might be relevant vs.
         if ( level_err .lt. 2 ) then
c								      ! K_cond
            if ( ( fthi_edge .le. 0.0 .and. slr .le. rcondswlo ) .or.
     $           ( frhi_edge .le. 0.0 .and.
     $           ( slt .lt. sltswhi_alex .or.
     $           slr .le. rcondswlo ) .and.
     $           ( kdo_alex .le. 0 .or. slt .ge. sltswhi_alex .or.
     $           flrho .ge. flrhoswhi_alex ) ) ) return
c								! level_err > 1
         else if ( ( fthi_edge .le. 0.0 .and. ( kdo_cond .le. 0 .or.
     $           slr .le. rcondswlo ) ) .or. ( frhi_edge .le. 0.0 .and.
     $           ( kdo_cond .le. 0 .or. slt .lt. sltswhi_alex .or.
     $           slr .le. rcondswlo ) .and.
     $           ( kdo_alex .le. 0 .or. slt .ge. sltswhi_alex .or.
     $           flrho .ge. flrhoswhi_alex ) ) ) then
c						 ! level_err > 1: stop at edge
            write(6,20) slt+6., slr, flrho
            stop ' STOP -- OPAL Error: bad T or R value. '
c
         endif
c
      endif
c
c..... convert xh to logarithmic shifted by xdel (C and O are converted later)
c
      xxx = log10(xdel+xh)
c
c..... Determine log R and log T6 grid points to use in the interpolation.
c      Try to avoid overestimating the extent of extrapolation into any cutout.
c
      if ( slt .gt. flt81m6 ) then
         k2sat = ntdel + min( nt , k81 + max( 0 ,
     $        int( ( slt - flt81m6 ) * dfs(nt) - small_1m6 ) ) )
      else if ( slt .gt. flt60m6 ) then
         k2sat = ntdel + min( k80 , k60 + max( 0 ,
     $        int( ( slt - flt60m6 ) * dfs(k81) - small_1m6 ) ) )
      else if ( k60 .le. 0 ) then
         k2sat = ntdel + k60
      else
         k2sat = min( ks59 , max( ntdel ,
     $        int( ( slt - flt370m6 ) * dfs(k60) + small_1m6 ) ) )
      endif
c
      if ( slr .gt. flrmid ) then
         l2sat = nrm - max( 0 , min( nr ,
     $        int( ( alr(nr) - slr ) * dfsr(nr) + one_p_small_1m6 ) ) )
      else
         l2sat = nrdel + max( 0 , min( nr ,
     $        int( ( slr - alr(1) ) * dfsr(nr) + one_p_small_1m6 ) ) )
      endif
c
      k1x = -99
      l1x = -99
      k3sat = k2sat+1
      k2 = max(k2sat-ntdel,1)
      k3 = min(k3sat-ntdel,nt)
      l3sat = l2sat+1
      l4sat = min(l3sat,nre)+1
      l2 = max(l2sat-nrdel,1)
      l3 = min(l3sat-nrdel,nr)
c					! if too far outside, return at low T,R
      if ( min(k3,l3) .le. 0 ) then
c
         if ( l3 .le. 0 ) frlo_edge = 0.
         if ( k3 .le. 0 ) ftlo_edge = 0.
         ftredge = 0.
         fedge = 0.
         if ( kdo_alex .le. 0 .and. level_err .ge. 2 ) then
            write(6,20) slt+6., slr, flrho
            stop ' STOP -- OPAL Error: bad T or R value. '
         endif
         return
c						   ! but extrap at high T,R
      else if ( k2 .gt. nt .or. l2 .gt. nr ) then
c
         if ( l2 .gt. nr ) frhi_edge = 0.
         if ( k2 .gt. nt ) fthi_edge = 0.
         ftredge = 0.
         fedge = 0.
c
         if ( level_err .lt. 2 ) then
c
            if ( ( fthi_edge .le. 0.0 .and. slr .le. rcondswlo ) .or.
     $           ( frhi_edge .le. 0.0 .and.
     $           ( slt .lt. sltswhi_alex .or.
     $           slr .le. rcondswlo ) .and.
     $           ( kdo_alex .le. 0 .or. slt .ge. sltswhi_alex .or.
     $           flrho .ge. flrhoswhi_alex ) ) ) return
c
         else if ( ( fthi_edge .le. 0.0 .and. ( kdo_cond .le. 0 .or.
     $           slr .le. rcondswlo ) ) .or. ( frhi_edge .le. 0.0 .and.
     $           ( kdo_cond .le. 0 .or. slt .lt. sltswhi_alex .or.
     $           slr .le. rcondswlo ) .and.
     $           ( kdo_alex .le. 0 .or. slt .ge. sltswhi_alex .or.
     $           flrho .ge. flrhoswhi_alex ) ) ) then
c						 ! level_err > 1: stop at edge
            write(6,20) slt+6., slr, flrho
            stop ' STOP -- OPAL Error: bad T or R value. '
c
         endif
c
      endif
c					 ! initial assumption: 3x3 grid in T,R
      ipx = 2
      do i = 1, 4
         iqx(i) = 2
      enddo
c					! Check upper-right ragged cut-out:
      if ( l2sat .gt. 0 .and. ftredge .gt. 0.0 ) then
c							. . .
c						1.	. .      too far out to
c							. .  *   extrapolate
         if ( k2sat .gt. nta(l2sat) ) then
c
            ftr_cut_edge = 0.
            ftredge = 0.
            fedge = 0.
c							. . .    extrapolate
c						2.	. . .    T and R out
c							. .  *   from a corner
         else if ( k2sat .eq. nta(l2sat) .and.
     $           k2sat .gt. nta(l3sat) ) then
c
            ftcut_edge = min( 1.0 ,
     $           ( alt(k2) - slt ) * dfs(k3) + 1.000001 )
            frcut_edge = min( 1.0 ,
     $           ( alr(l2) - slr ) * dfsr(l3) + 1.000001 )
            ftr_cut_edge = min( ftcut_edge , frcut_edge )
            frhi_edge = min( frhi_edge , ftr_cut_edge )
            ftredge = max( 0.0 , min( ftredge , ftr_cut_edge ) )
c-dont;            k1x = k2-2
c-dont;            l1x = l2-2
c						. . .	. . .   extrapolate (in
c					3.	. .*	. . .   either T or R)
c						. .	. .*    in a corner
         else if ( k2sat .lt. nta(l2sat) .and.
     $           k2sat .eq. nta(l3sat) ) then
c
            ftcut_edge = min( 1.0 ,
     $           ( alt(k2) - slt ) * dfs(k3) + 1.000001 )
            frcut_edge = min( 1.0 ,
     $           ( alr(l2) - slr ) * dfsr(l3) + 1.000001 )
            ftr_cut_edge = max( ftcut_edge , frcut_edge )
            ftredge = max( 0.0 , min( ftredge , ftr_cut_edge ) )
c						. . .	. . .     extrapolate R
c					4.	. .	. . .*    out from a
c						. .*	. . .*    high-R edge
         else if ( k2sat .lt. nta(l2sat) .and.
     $           k2sat .gt. nta(l3sat) ) then
c
            if ( l2 .lt. nr ) then
               frcut_edge = min( 1.0 ,
     $              ( alr(l2) - slr ) * dfsr(l3) + 1.000001 )
               ftr_cut_edge = frcut_edge
               ftredge = max( 0.0 , min( ftredge , ftr_cut_edge ) )
            endif
c-dont;            if ( k3sat .lt. nta(l2sat) .and. k2sat .gt. ntb ) ipx = 3
c-dont;            k1x = max(k2-1,1)
c-dont;            l1x = l2-2
c						. . .	. . . .  interpolate,
c					5.	. .*.	. .*.*.  1-space inside
c						.*.*.	.*.*.    high-R,T edges
c-dont;         else if ( k3sat .le. nta(l3sat) .and.
c-dont;     $           k3sat .ge. nta(l4sat) ) then
c
c-dont;            if ( k3sat .lt. nta(l3sat) .and. k2sat .gt. ntb ) ipx = 3
c-dont;            k1x = max(k2-1,1)
c-dont;            l1x = max(l2-1,1)
c-dont;            if ( l2sat .gt. nrb ) then
c-dont;               do i = 1,3
c-dont;                  if ( k1x-1+ntdel+i .le. nta(l4sat) ) iqx(i) = 3
c-dont;               enddo
c-dont;            endif
c
         endif
c
      endif
c
      fedge = max( 0.0 , ftredge * fzedge )
c					     ! hi-T cut-out always extrapolated
c							 ! unless level_err > 1
      if ( level_err .ge. 2 .and. ftredge .le. 0. ) then
         write(6,20) slt+6., slr, flrho
         stop ' STOP -- OPAL Error: bad T or R value. '
      endif
c							 . . . .   Outside or
c							 . . . .   1-space
c						6.	*. . .     inside max
c							* * *      high-T edge
c-dont;      if ( k1x .lt. 0 .and. k3sat .ge. ntm ) then
c-dont;         k1x = nt_m2
c-dont;         l1x = max(l2-1,1)
c-dont;         if ( l2sat .gt. nrb ) then
c-dont;            do i = 1,3
c-dont;               if ( ntm_m3+i .le. nta(l4sat) ) iqx(i) = 3
c-dont;            enddo
c-dont;         endif
c				   7.   Anywhere except high-T or high-R edges:
c-dont;      else if ( k1x .lt. 0 ) then
c-dont;         k1x = max(k2-1,1)
c-dont;         l1x = max(l2-1,1)
c-dont;         if ( k2sat .gt. ntb ) ipx = 3
c-dont;         if ( l2sat .gt. nrb ) then
c-dont;            do i = 1,4
c-dont;               iqx(i) = 3
c-dont;            enddo
c-dont;         endif
c-dont;      endif
c					     ! high-T,R cutout has O.K. values
      k1x = min( nt_m2 , max( k2 - 1 , 1 ) )
      l1x = min( nr_m2 , max( l2 - 1 , 1 ) )
      if ( k1x .lt. k2 .and. k3 .lt. nt ) ipx = 3
      if ( l1x .lt. l2 .and. l3 .lt. nr ) then
         do i = 1, 4
            iqx(i) = 3
         enddo
      endif
c		       ! check low-T,low-R corner for X=0; avoid it if possible
      ichgr = 1
      if ( mf .eq. mxzero .and. k1x+ntdel .lt. ntax0(l1x+nrdel) ) then
c									! avoid
         if ( mf2 .eq. mf+3 ) then
            mf = mf2-2
            mg = mf2-1
            mh = mf2
c						   ! like region 1. too far out
         else if ( k3sat .lt. ntax0(l3sat) ) then
            ftredge = 0.
            fedge = 0.
            ftlo_edge = 0.
            if ( level_err .ge. 2 .and. kdo_alex .le. 0 ) then
               write(6,20) slt+6., slr, flrho
               stop ' STOP -- OPAL Error: bad T or R value. '
            endif
            return
c		     ! else, will need to revise T,R indices for first m (= mf)
         else
            ichgr = 0
         endif
      endif
c						    ! check similarly for X=.03
      if ( ( mf .eq. mx03 .or. mg .eq. mx03 ) .and.
     $     k1x+ntdel .lt. ntax03(l1x+nrdel) ) then
c									! avoid
         if ( mf2 .eq. mf+3 .and. mf .eq. mx03 ) then
            mf = mf2-2
            mg = mf2-1
            mh = mf2
c						   ! like region 1. too far out
         else if ( k3sat .lt. ntax03(l3sat) ) then
            ftredge = 0.
            fedge = 0.
            ftlo_edge = 0.
            if ( level_err .ge. 2 .and. kdo_alex .le. 0 ) then
               write(6,20) slt+6., slr, flrho
               stop ' STOP -- OPAL Error: bad T or R value. '
            endif
            return
c					! if need to revise T,R indices for mf:
         else if ( mf .eq. mx03 ) then
            ichgr = 0
         endif
      endif
c	     ! xhemxi: subtract Z to prevent out-of-range C+O values at small X
c
      xhemxi = max( 1. - xh - z , 0. )
      if ( kzf2 .gt. kzf ) then
         zlogd = log10( z + zdel )
      else
         zlogd = 0.0
      endif
c-debug[
c-debug;      ichk = 0
c-debug;      oudebl_sto = oudebl
c-debug;      if ( fedge .le. 0.0 ) oudebl = max( oudebl , badlogklim )
c-debug;      if ( ioudeb .gt. 1 ) then
c-debug;         write(6,'(/" ----- opal_k_only( z=",f10.7,", xh=",f10.7,
c-debug;     $        ", exC=",f10.7,", exO=",f10.7,", slt=",f10.6,
c-debug;     $        ", slr=",f10.6,", fcn=",f10.7,", fcon=",f10.7,
c-debug;     $        ", fcnone=",f10.7,", fu=",f10.7," ) -----"/
c-debug;     $        "    mf,mg,mh,mf2=",4i2," k1x=",i3," ipx=",i2,
c-debug;     $        " l1x=",i3," iqx(1:",i1,")=",4i2)')
c-debug;     $        z,xh,exC,exO,slt,slr,fcn,fcon,fcnone,fu, mf, mg, mh, mf2,
c-debug;     $        k1x, ipx, l1x, ipx + 1, ( iqx(i), i = 1, ipx + 1 )
c-debug;      endif
c-debug]
c				! ------------------------- loop over X-mixes m
      do m = mf, mf2
c				  ! set (or restore) grid-indices, if necessary
         if ( ichgr .ne. 0 ) then
            do i = 1,4
               iq(i) = iqx(i)
            enddo
            ip = ipx
            k1 = k1x
            l1 = l1x
            k2 = k1+1
            k3 = min( k1 + 2 , nt )
            k4 = min( k1 + 3 , nt )
            l2 = l1+1
            l3 = min( l1 + 2 , nr )
            l4 = min( l1 + 3 , nr )
         endif
c				! check for low-T,low-R cutout at X=0 or X=.03:
         ichgr = 0
         if ( m .eq. mxzero .and.
     $        k1x+ntdel .lt. ntax0(l1x+nrdel) ) then
            ichgr = 1
            do i = max(l2sat-2,0),min(l4sat+2,nrm)
               ntaxat(i) = ntax0(i)
            enddo
         else if ( m .eq. mx03 .and.
     $           k1x+ntdel .lt. ntax03(l1x+nrdel) ) then
            ichgr = 1
            do i = max(l2sat-2,0),min(l4sat+2,nrm)
               ntaxat(i) = ntax03(i)
            enddo
         endif
c				  ! change grid indices, if in low-{R,T} cutout
         if ( ichgr .ne. 0 ) then
            k3 = min(k3sat-ntdel,nt)
            l3 = min(l3sat-nrdel,nr)
            l1sat = max(l2sat-1,0)
            ip = 2
            do i = 1,4
               iq(i) = 2
            enddo
c					       ! 2. extrapolate T,R from corner
            if ( k3sat .eq. ntaxat(l3sat) .and.
     $           k3sat .lt. ntaxat(l2sat) ) then
               if ( l4sat .ge. nre ) then
                  ftlo_edge = 0.
                  ftredge = 0.
               else
                  ft = min( 1.0 ,
     $                 ( slt - alt(k3) ) * dfs(k3) + 1.000001 )
                  fr = min( 1.0 ,
     $                 ( slr - alr(l3) ) * dfsr(l3) + 1.000001 )
                  ftlo_edge = min( ftlo_edge , ft , fr )
                  ftredge = max( 0.0 , min( ftredge , ftlo_edge ) )
                  k1 = k3
                  l1 = l3
               endif
c						   ! 3. extrap T or R in corner
            else if ( k3sat .gt. ntaxat(l3sat) .and.
     $              k3sat .eq. ntaxat(l2sat) ) then
               ft = min( 1.0 ,
     $              ( slt - alt(k3) ) * dfs(k3) + 1.000001 )
               fr = min( 1.0 ,
     $              ( slr - alr(l3) ) * dfsr(l3) + 1.000001 )
               ftlo_edge = min( ftlo_edge , max( ft , fr ) )
               ftredge = max( 0.0 , min( ftredge , ftlo_edge ) )
               if ( ft .gt. fr .or. l4sat .ge. nre ) then
                  k1 = k3
                  l1 = l3-2
                  if ( k3sat .lt. ntaxat(l1+nrdel) ) then
                     l1 = l3-1
                     if ( l3 .ge. nr ) then
                        ftlo_edge = 0.
                        ftredge = 0.
                     endif
                  else if ( l3 .lt. nr ) then
                     do i = 1,3
                        iq(i) = 3
                     enddo
                  endif
               else
                  k1 = max(ntaxat(l3sat)-ntdel,k3-2)
                  l1 = l3
                  if ( k1 .eq. k3-2 ) ip = 3
               endif
c						     ! 4. extrapolate R
            else if ( k3sat .gt. ntaxat(l3sat) .and.
     $              k3sat .lt. ntaxat(l2sat) ) then
               if ( l4sat .ge. nre ) then
                  ftlo_edge = 0.
                  ftredge = 0.
               else
                  k1 = max(ntaxat(l3sat)-ntdel,k3-2)
                  l1 = l3
                  if ( k1 .eq. k3-2 ) ip = 3
                  if ( l3 .gt. 1 ) then
                     fr = min( 1.0 ,
     $                    ( slr - alr(l3) ) * dfsr(l3) + 1.000001 )
                     ftlo_edge = min( ftlo_edge , fr )
                     ftredge = max( 0.0 , min( ftredge , fr ) )
                  endif
               endif
c						     ! 8. extrapolate T
            else if ( k3sat .eq. ntaxat(l3sat) .and.
     $              k3sat .eq. ntaxat(l2sat) ) then
               k1 = k3
               l1 = l3-2
               if ( k3sat .lt. ntaxat(l1+nrdel) ) then
                  l1 = l3-1
                  if ( l3 .ge. nr ) then
                     ftredge = 0.
                     ftlo_edge = 0.
                  endif
               else if ( l3 .lt. nr ) then
                  do i = 1,3
                     iq(i) = 3
                  enddo
               endif
               if ( k3 .gt. 1 ) then
                  ft = min( 1.0 ,
     $                 ( slt - alt(k3) ) * dfs(k3) + 1.000001 )
                  ftlo_edge = min( ftlo_edge , ft )
                  ftredge = max( 0.0 , min( ftredge , ft ) )
               endif
c							    ! 5. inside an edge
            else if ( k2sat .ge. ntaxat(l2sat) .and.
     $              k2sat .le. ntaxat(l1sat) ) then
               if ( k2sat .eq. ntaxat(l2sat) .or. l3 .eq. nr ) then
                  l1 = l3-2
                  k1 = k3-1
                  if ( k2sat .lt. ntaxat(l1+nrdel) ) then
                     if ( l3 .lt. nr ) then
                        l1 = l3-1
                     else if ( k3sat .lt. ntaxat(l1+nrdel) ) then
                        ftlo_edge = 0.
                        ftredge = 0.
                     else
                        k1 = k3
                        ft = min( 1.0 ,
     $                       ( slt - alt(k3) ) * dfs(k3) + 1.000001 )
                        ftlo_edge = min( ftlo_edge , ft )
                        ftredge = max( 0.0 , min( ftredge , ft ) )
                     endif
                  else if ( l3 .lt. nr ) then
                     do i = 1,3
                        iq(i) = 3
                     enddo
                  endif
               else
                  k1 = max(k3-2,1)
                  l1 = l3-1
                  if ( k1 .eq. k3-2 ) ip = 3
               endif
            endif
c					! if too far out to extrapolate, return
            if ( ftredge .le. 0. ) then
               ftlo_edge = 0.
               fedge = 0.
               opact = badlogkval
               if ( level_err .ge. 2 .and. kdo_alex .le. 0 ) then
                  write(6,20) slt+6., slr, flrho
                  stop ' STOP -- OPAL Error: bad T or R value. '
               endif
               return
            endif
c					   ! use smaller of X=0 or X=.03 values
c
            fedge = max( 0.0 , ftredge * fzedge )
c
c					   ! get rest of revised grid indices
            k2 = k1+1
            k3 = k1+2
            k4 = k1+3
            l2 = l1+1
            l3 = l1+2
            l4 = l1+3
c			! end of revised grid in low-T,R cutout
         endif
c			     ! ------------------------- loop over Z-values kz:
         do kz = kzf, kzf2
c				! xhemx: subtract Z to prevent out-of-range C+O
c						! values at small X
            xhemxz = 1. - xa(m)
            xhemx = xhemxz - zsto(kz)
c							! If no X or Z interp
            if ( kzf2 .eq. kzf .and. mf2 .eq. mf ) then
c
               xxc = exC
               xxo = exO
c				! Else, if we will be interpolating in X or Z:
            else
c
c............. C and O  fractions determined by the ray through the origin that
c              also passes through the point (Xc,Xo). Specific interpolation 
c              values are determined by tabulated X values; i.e., xa(m).
c              Interpolation along the ray gives log(kappa(Xc,Xo)).
c              (Advantage of method: keeps indices within table boundaries.)
c
               if ( xh .ge. xa(mx) + 0.1 ) then
                  cmod = 1.0
               else if ( xh .gt. xa(mx) ) then
                  cmod = ( ( xa(mx) + 0.1 - xh ) * xhemx / xhemxi
     $                 + ( xh - xa(mx) ) ) * 10.0
               else if ( xhemxi .gt. small_1m6 ) then
                  cmod = xhemx / xhemxi
               else
                  cmod = 0.
               endif
c
               if ( exC .gt. 0. ) then
                  xxc = min( cmod * exC , xhemxz )
               else if ( exC .ge. small_m1m8 .or.
     $                 z .lt. small_1m8 ) then
                  xxc = 0.
               else
                  xxc = max( exC / z , -1. ) * zsto(kz)
               endif
c
               if ( exO .gt. 0. ) then
                  xxo = min( cmod * exO , xhemxz )
               else if ( exO .ge. small_m1m8 .or.
     $                 z .lt. small_1m8 ) then
                  xxo = 0.
               else
                  xxo = max( exO / z , -1. ) * zsto(kz)
               endif
c
            endif
c
            xxco = xxc + xxo
            if ( xxco .gt. xhemxz + small_1m6 ) then
               cmod = xhemxz / xxco
               xxc = xxc * cmod
               xxo = xxo * cmod
            endif
c
c..... convert xxc and xxo to logarithmic shifted by Z+zdel
c
            cxx = log10(zzz(kz)+xxc)
            oxx = log10(zzz(kz)+xxo)
c				    ! set up table C,O abundances for this m,kz
            nc = n(m,1,kz)
            no = nc
            do i = 1,nc-1
               xc(i) = xcs(i)
               xo(i) = xos(i)
            enddo
            xc(nc) = xhemx
            xo(nc) = xhemx
c
            do i = 1,nc
               ox(i) = oxf(m,i,kz)
               cx(i) = cxf(m,i,kz)
               xcd(i) = xcdf(m,i,kz)
               xod(i) = xodf(m,i,kz)
               cxd(i) = cxdf(m,i,kz)
               oxd(i) = oxdf(m,i,kz)
            enddo
c
            xodp = max(-xxc+xc(nc),0.)
            xcdp = max(-xxo+xo(no),0.)
c-debug[
c-debug;            if ( m .eq. mf .and. kz .eq. kzf .and. ioudeb .gt. 0 )
c-debug;     $           write(6,9409) z,xh,exC,exO,10.**slt,slt,slr,
c-debug;     $           xxc,xxo,mf,mf2,kzf,kzf2,k1,ip,l1,(iq(i),i=1,ip+1)
c-debug; 9409       format(' '/' OPAL: Z',f10.7,' X',f10.7,' C',f10.7,
c-debug;     $           ' O',f10.7,' T6',f12.7,' logT6',f11.7,' logR',f11.7,
c-debug;     $           ' xxc',f10.7,' xxo',f10.7,' m',2i2,' kz',2i3,
c-debug;     $           ' k',i3,'+',i1,' l',i3,'+',4i1)
c-debug]
c
c  Interpolate in C and O: COINTSMO is better, and was more thoroughly tested:
c
            if ( interp_CO_smo .gt. 0 ) then
               call cointsmo(xxc,xxo,kz)
            else
               call cointerp(xxc,xxo,kz)
            endif
c				! ---------------- end of loop over Z-values kz
         enddo
c
c....... Interpolate in Z, if necessary, mixing overlapping quadratics.
c
         call qzlog4int( zlogd )
c
c....... completed C,O,Z interpolation. Now interpolate T6 and log R, usually
c        on a 4x4 grid. (log(T6(i)),i=i1,i1+3),log(R(j)),j=j1,j1+3)).  Grid may
c        differ between X=0, X=.03, and X>.03 mixes, under some conditions.
c        Procedure mixes overlapping quadratics to obtain smoothed derivatives.
c
         call t6rinterp(slr,slt)
c				  ! ---------------- end of loop over X-mixes m
      enddo
c
c  Completed C,O,Z,T6,R interpolation; interpolate logKappa & derivatives in X
c
c			! for low T with 0.0 < X < 0.1, may need to reduce xdel
      xdelat = xdel
      if ( mf .eq. mxzero .and. mg .eq. mx03 .and. mh .eq. mf+2 ) then
         delhi = opk(mh,1) - opk(mg,1)
         dello = opk(mg,1) - opk(mf,1)
         if ( delhi .gt. 0.02 .and. delhi .lt. dello ) then
            xdelat = max( xdel*(delhi/dello)**2 , xdelmin )
            if ( delhi .lt. 0.1 .and. xdelat .lt. xdel )
     $           xdelat = xdelat + (xdel-xdelat)*((0.1-delhi)*12.5)**2
            if ( xdelat .lt. xdel ) then
               is = 0
c			 ! get (mf,mg,mh)-interpolated values with revised xdel
               do i = 1, 4
                  opvals(i) = qzinter(is,1,xh,2,opk(mf,i),opk(mg,i),
     $                 opk(mh,i),0.0,xa(mf),xa(mg),xa(mh),0.0,xdelat)
                  is = 1
               enddo
            endif
         endif
      endif
c
      is = 0
c			! these initializations just prevent compiler warnings:
      dixr = 0.0
      x_3 = 0.0
      x_4 = 0.0
c-debug[
      x_1 = 0.0
      x_2 = 0.0
c-debug]
c			           ! if use only one X-table
      if ( mf .eq. mh ) then
         do i = 1,4
            opvals(i) = opk(mf,i)
         enddo
c-test-xdel[
c-test-xdel;         do i = 1,n_xdel_test
c-test-xdel;            opdxi(i) = opact
c-test-xdel;         enddo
c-test-xdel]
c			          ! 2 tables: interpolate linearly in X
      else if ( mg .eq. mh ) then
         dixr = (xx(mg)-xxx)*dfsx(mg)
         do i = 1,4
            opvals(i) = opk(mf,i)*dixr + opk(mg,i)*(1.-dixr)
         enddo
c-test-xdel[
c-test-xdel;         do i = 1,n_xdel_test_m1
c-test-xdel;            opdxi(i) = ( opk(mf,1)
c-test-xdel;     $           * log10((xa(mg)+xdel_test(i))/(xh+xdel_test(i)))
c-test-xdel;     $           + opk(mg,1)
c-test-xdel;     $           * log10((xh+xdel_test(i))/(xa(mf)+xdel_test(i))) )
c-test-xdel;     $           / log10((xa(mg)+xdel_test(i))
c-test-xdel;     $           /(xa(mf)+xdel_test(i)))
c-test-xdel;         enddo
c-test-xdel;         opdxuse = opact
c-test-xdel]
c			           ! 3 tables: interpolate in X using quadratic
      else if ( mh .eq. mf2 ) then
c				      ! if revised xdel was NOT used (usually!)
         if ( xdelat .ge. xdel ) then
            call quadsto( 1, xxx, xx(mf), xx(mg), xx(mh) )
            do i = 1, 4
               opvals(i) = quadget( 1, opk(mf,i),
     $                              opk(mg,i), opk(mh,i) )
            enddo
         endif
c-test-xdel[
c-test-xdel;         do i = 1,n_xdel_test_m1
c-test-xdel;            opdxi(i) = quad(0,1,log10(xh+xdel_test(i)),
c-test-xdel;     $           opk(mf,1),opk(mg,1),opk(mh,1),
c-test-xdel;     $           log10(xa(mf)+xdel_test(i)),
c-test-xdel;     $           log10(xa(mg)+xdel_test(i)),
c-test-xdel;     $           log10(xa(mh)+xdel_test(i)))
c-test-xdel;         enddo
c-test-xdel;         opdxuse = opact
c-test-xdel]
c		   ! 4 tables: interpolate X between two overlapping quadratics
c				      ! if revised xdel was NOT used (usually!)
      else if ( xdelat .ge. xdel ) then
c						! may need dixr later below
         dixr = ( xx(mh) - xxx ) * dfsx(mh)
c
         call quad4sto( 1, xxx, xx(mf), xx(mg), xx(mh), xx(mf2) )
         do i = 1, 4
            opvals(i) = quad4get( 1, opk(mf,i), opk(mg,i),
     $                            opk(mh,i), opk(mf2,i) )
         enddo
c		  ! else, if revised xdel was used, combine it with (mg,mh,mf2)
      else
c
         call quadsto( 2, xxx, xx(mg), xx(mh), xx(mf2) )
         dixr = ( xx(mh) - xxx ) * dfsx(mh)
         do i = 1,4
            opvals(i) = opvals(i) * dixr + ( 1. - dixr )
     $           * quadget( 2, opk(mg,i), opk(mh,i), opk(mf2,i) )
         enddo
c-test-xdel[
c-test-xdel;         do i = 1,n_xdel_test_m1
c-test-xdel;            opdxi(i) = ( quad(0,1,log10(xh+xdel_test(i)),opk(mf,1),
c-test-xdel;     $           opk(mg,1),opk(mh,1),log10(xa(mf)+xdel_test(i)),
c-test-xdel;     $           log10(xa(mg)+xdel_test(i)),
c-test-xdel;     $           log10(xa(mh)+xdel_test(i)))
c-test-xdel;     $           * log10((xa(mh)+xdel_test(i))/(xh+xdel_test(i)))
c-test-xdel;     $           + quad(0,2,log10(xh+xdel_test(i)),opk(mg,1),
c-test-xdel;     $           opk(mh,1),opk(mf2,1),log10(xa(mg)+xdel_test(i)),
c-test-xdel;     $           log10(xa(mh)+xdel_test(i)),
c-test-xdel;     $           log10(xa(mf2)+xdel_test(i)))
c-test-xdel;     $           * log10((xh+xdel_test(i))/(xa(mg)+xdel_test(i))) )
c-test-xdel;     $           / log10((xa(mh)+xdel_test(i))
c-test-xdel;     $           /(xa(mg)+xdel_test(i)))
c-test-xdel;         enddo
c-test-xdel;         opdxuse = opact
c-test-xdel]
      endif
c-debug[
c-debug;      if ( fedge .le. 0.0 ) oudebl = max( oudebl , badlogklim )
c-debug;      do m = mf,mf2
c-debug;         if ( .not. abs(opk(m,1)) .le. oudebl ) ichk = 1
c-debug;      enddo
c-debug;      if ( ioudeb .gt. 1 .or. ichk .gt. 0 .or.
c-debug;     $     .not. abs(opact) .le. oudebl ) then
c-debug;         write(6,8415) 'Post-basic-X-interp:',
c-debug;     $        mf,mg,mh,mf2,kzf,kzf2,k1,ip,l1,iq(1),iq(2),
c-debug;     $        iq(3),iq(ip+1),z,xh,exC,exO,slt,slr
c-debug; 8415    format(' '/' ',a/' opk(X): m',4i3,' kz',2i3,' k1',i3,'+',i1,
c-debug;     $        ' l1',i3,'+',4i1,' Z',f10.7,' X',f10.7,' C',f10.7,
c-debug;     $        ' O',f10.7,' logT6',f12.7,' logR',f12.7)
c-debug;         do m = mf,mf2
c-debug;            write(6,8473) '    ',m,min(xa(m),1.-z),(opk(m,i),i=1,4)
c-debug; 8473       format(a4,' (x',i2.2,') X=',f10.7,' logK=',g15.7,
c-debug;     $           ' DT=',g15.7,' DR=',g15.7,' DTro=',g15.7,a4)
c-debug;         enddo
c-debug;         write(6,8473) ' -->',0,xh,(opvals(i),i=1,4),' <--'
c-debug;      endif
c-debug;      do i = 1, 4
c-debug;         opv_prev(i) = opvals(i)
c-debug;      enddo
c-debug]
c
c  If the 'GN93hz' X-indices will be needed, obtain them:
c
      if ( f_xhi .gt. 0. .or. max( need_cno , need_user ) .gt. 0 ) then
c
c								! X < 0.1:
         if ( xh .le. 0.099999 ) then
c					! set new mf,mg,mh,mf2 so that only the
c					! upper X-interp quadratic is shifted
            mf = 1
            mg = 1
            if ( mf2 .ne. mxzero ) then
               mh = 2
               mf2 = 3
            else
               mh = 1
               mf2 = 1
            endif
c-debug[
            x_1 = xhi_in(mf)
            x_2 = xhi_in(mg)
            x_3 = xhi_in(mh)
            x_4 = xhi_in(mf2)
c-debug]
c								! X = 1-Z:
         else if ( xh .gt. 0.999999 - z ) then
c								! high-X edge
            mf = mx_hi
            mg = mx_hi
            mh = mx_hi
            mf2 = mx_hi
c-debug[
            x_1 = 1. - z
            x_2 = x_1
            x_3 = x_1
            x_4 = x_1
c-debug]
c					    ! X > 0.9: possibly fancy Z-interp:
         else if ( xh .ge. 0.9000009 ) then
c						! first: set new mf,mg,mh,mf2
            mf2 = nx_hi(kzf)
            x_4 = 1. - z
            mg = min( mx_hi - 2 , mf2 - 1 )
            mf = mg - 1
            mh = mg + 1
c-debug[
            x_1 = xhi_in(mf)
            x_2 = xhi_in(mg)
            x_3 = xhi_in(mh)
c-debug]
c								! X = 0.95 case
            if ( abs( xhi_in(mh) - xh ) .lt. small_9m7 .and.
     $           xhi_use(mf2,kzf2) .ge. xhi_in(mh) - small_1m6 ) then
c
               mh = mg + 1
               mf2 = mh
               mg = mh
               mf = mh
               x_3 = 0.0
c						! 3-X-pt: Z > Zsto(kzf) > 0.05
            else if ( mf2 .eq. mg + 1  ) then
c
               mh = mf2
               x_3 = x_4
c						  ! 4-X-pt: Zsto(kzf2) < 0.05
            else if ( nx_hi(kzf2) .eq. mf2 ) then
c
               x_3 = xhi_use(mh,kzf2)
c							! 3-X-pt: X > 0.95
               if ( xh .ge. x_3 - small_9m7 ) mf = mg
c							      ! Otherwise
            else
c
               if ( z .lt. zsto(kzh) - zacc(kzh) ) then
                  k_k = kzg
               else
                  k_k = kzh
               endif
               if ( nx_hi(k_k) .lt. mf2 ) then
c						! kzf2 *     * *     Z |
c						!      |     |  \      |
c						! kzh  *     *   *     +---> X
c						!      |     | x  \
c						! kzg  *     *     *    (use 3
c						!      |     |     |\    X-pts)
c						! kzf  *     *     * *
c						!      mf   mg    mh  mf2
                  mh = mf2
                  x_3 = x_4
               else
c						! kzf2 *     * *     Z |
c						!      |     |  \      |
c						! kzh  *     *   *     +---> X
c						!      |     |    \
c						!      |     | x  |\  (usually
c						! kzg  *     *    * *   use 4
c						!      |     |    |  \   X-pts)
c						! kzf  *     *    *   *
c						!      mf   mg   mh  mf2
c
                  if ( xhi_use(mh,kzh) .ge.
     $                 xhi_in(mh) - small_1m6 ) then
                     x_3 = xhi_in(mh)
                  else
c						  ! mh: curved Z-interpolation
                     x_3 = qzinter(0,1,z,kzf2-kzf,
     $                    xhi_use(mh,kzf),xhi_use(mh,kzg),
     $                    xhi_use(mh,kzh),xhi_use(mh,kzf2),zsto(kzf),
     $                    zsto(kzg),zsto(kzh),zsto(kzf2),zdel)
                  endif
c							 ! 3-X-pt: X > 0.95
                  if ( xh .ge. x_3 - small_9m7 ) mf = mg
               endif
c
            endif
c					! ELSE: general case: 0.1 < X < 0.9:
         else
c
            mg = 2
            mh = mx_hi - 2
            do while ( mh - mg .gt. 1 )
               imd = ( mg + mh ) / 2
               if ( xh .le. xhi_in(imd) ) then
                  mh = imd
               else
                  mg = imd
               endif
            enddo
c							       ! exact X-value:
            if ( abs( xh - xhi_in(mh) ) .lt. small_9m7 ) then
               mf = mh
               mg = mh
               mf2 = mh
            else if ( abs( xh - xhi_in(mg) ) .lt. small_9m7 ) then
               mf = mg
               mh = mg
               mf2 = mg
c					     ! or general 4-pt X-interpolation:
            else
               mf = mg - 1
               mf2 = min( mh + 1 , nx_hi(kzf) )
            endif
c-debug[
            x_1 = xhi_in(mf)
            x_2 = xhi_in(mg)
c-debug]
c				      ! get the X-values for 3rd and 4th X-pts:
            x_3 = xhi_in(mh)
c					! 3-X-pt case
            if ( mf2 .eq. mh ) then
               x_4 = x_3
c						! x4 = 0.9 or smaller
            else if ( mf2 .le. mx_hi - 2 ) then
               x_4 = xhi_in(mf2)
c							! x4 = 0.95 or 1-Z
            else if ( nx_hi(kzf2) .eq. nx_hi(kzf) ) then
               x_4 = max( x_3 , min( xhi_use(mf2,kzf) , 1. - z ) )
c								   ! otherwise
            else
               if ( z .lt. zsto(kzh) - zacc(kzh) ) then
                  k_k = kzg
               else
                  k_k = kzh
               endif
               if ( nx_hi(k_k) .lt. mf2 ) then
c						! kzf2 *     * *     Z |
c						!      |     |  \      |
c						! kzh  *     *   *     +---> X
c						!      |  x  |    \
c						! kzg  *     *     *   x4 = 1-Z
c						!      |     |     |\
c						! kzf  *     *     * *
c						!      mg   mh        mf2
                  mf2 = mx_hi
                  x_4 = 1. - z
               else
c						! kzf2 *     * *     Z |
c						!      |     |  \      |
c						! kzh  *     *   *     +---> X
c						!      |     |    \
c						!      |  x  |    |\   x4 from
c						! kzg  *     *    * *  the line
c						!      |     |    |  \   "mf2"
c						! kzf  *     *    *   *
c						!      mg   mh   mf2
c
                  if ( xhi_use(mf2,kzh) .ge.
     $                 xhi_in(mf2) - small_1m6 ) then
                     x_4 = xhi_in(mf2)
                  else
c						  ! mf2: curved Z-interpolation
                     x_4 = qzinter(0,1,z,kzf2-kzf,
     $                    xhi_use(mf2,kzf),xhi_use(mf2,kzg),
     $                    xhi_use(mf2,kzh),xhi_use(mf2,kzf2),zsto(kzf),
     $                    zsto(kzg),zsto(kzh),zsto(kzf2),zdel)
                  endif
               endif
            endif
         endif
c
      endif
c
c  If the 'GN93hz' X-values are not available, just check for X > 0.76:
c
      if ( f_xhi .le. 0.0 ) then
c							! extrap if level_err<2
         if ( xh .gt. 0.76 .and. kdo_xhi .le. 0 ) then
            tmp = max( 0.0 , 1.0 - ( xh - 0.76 ) / 0.04 )
            fedge = fedge * tmp
            if ( tmp .le. 0.0 .and. level_err .ge. 2 ) then
               write(6,30) xh
 30            format(' '/' OPAL: X=',f10.6,
     $              ' > 0.8, but GN93hz X-values unavailable')
               stop ' STOP -- OPAL Error: X too large. '
            endif
         endif
c			
c  If X > 0.03 and C+O is not too large, then the more-numerous X-values from
c  'GN93hz' can help; note that f_xhi was set above, according to this.
c
      else
c		! m is the temporary-opacity-storage X-index
         m = 0
c			  ! loop ix over 'GN93hz'-opacity-shift X-indices
         do ix = mf, mf2
c								    ! ix valid?
            if ( ix .le. mg .or. ix .eq. mh .or. ix .eq. mf2 ) then
c
               m = m + 1
c					     ! if X available from 'Gz???.x??':
               if ( ireq_hi(ix) .eq. 0 ) then
c						! no opacity shifts at this X
                  do i = 1, 4
                     opk(m,i) = 0.0
                  enddo
c				   ! ELSE: if X not available from 'Gz???.x??':
               else
c					! get opacity shifts: loop over Z, T, R
                  do kz = kzf, kzf2
                     ixm = min( ix , nx_hi(kz) )
                     if ( ixm .le. 5 ) then
                        io = mo
                     else
                        ixm = ixm - 5
                        io = mo_m1
                     endif
                     do it = k1,k1+ip
                        do ir = l1,l1+iq(it-k1+1)
                           opl(it,ir,kz) = co(ixm,mc,io,it,ir,kz)
                        enddo
                     enddo
                  enddo
c						! interpolate over Z
                  call qzlog4int( zlogd )
c						! interpolate over T and R
                  call t6rinterp(slr,slt)
c
               endif
c
            endif
c
         enddo
c
c  Now add the just-computed 'GN93hz' added-X-value opacity shifts and their
c  derivatives to the original opacity and derivative values:
c
c				    ! if 0.03 < X < 0.1 (1st quadratic absent):
c
         if ( mg .eq. 1 .and. mf2 .eq. 3 ) then
c
            call quadsto( 1, xxx, xxx_hi(1), xxx_hi(2), xxx_hi(3) )
            f_xhi = f_xhi * (1.-dixr)
            do i = 1, 4
               opvals(i) = opvals(i) + f_xhi
     $              * quadget( 1, opk(1,i), opk(2,i), opk(3,i) )
            enddo
c					! if use only one X-table
         else if ( mf .eq. mh ) then
c
            do i = 1, 4
               opvals(i) = opvals(i) + f_xhi * opk(1,i)
            enddo
c						! if x4 = 0.9 or smaller...
         else if ( mf2 .le. mx_hi - 2 ) then
c						! 3 tables:
            if ( mh .eq. mf2 ) then
c
               call quadsto( 1, xxx, xxx_hi(mf),
     $                       xxx_hi(mg), xxx_hi(mh) )
               do i = 1, 4
                  opvals(i) = opvals(i) + f_xhi
     $                 * quadget( 1, opk(1,i), opk(2,i), opk(3,i) )
               enddo
c						! or 4 tables:
            else
c
               call quad4sto( 1, xxx, xxx_hi(mf),
     $                        xxx_hi(mg), xxx_hi(mh), xxx_hi(mf2) )
               do i = 1, 4
                  opvals(i) = opvals(i) + f_xhi
     $                 * quad4get( 1, opk(1,i), opk(2,i),
     $                             opk(3,i), opk(4,i) )
               enddo
c
            endif
c			           ! 3 tables: interpolate in X using quadratic
         else if ( mh .eq. mf2 ) then
c
            if ( x_3 .eq. xhi_in(mh) ) then
               xx_3 = xxx_hi(mh)
            else
               xx_3 = log10( x_3 + xdel )
            endif
            call qchksto( 1, xxx, xxx_hi(mf), xxx_hi(mg), xx_3 )
            do i = 1, 4
               opvals(i) = opvals(i) + f_xhi
     $              * qchkget( 1, opk(1,i), opk(2,i), opk(3,i) )
            enddo
c					! 3 tables at high-X end of matrix
         else if ( mf .eq. mg ) then
c
            if ( x_3 .eq. xhi_in(mh) ) then
               xx_3 = xxx_hi(mh)
            else
               xx_3 = log10( x_3 + xdel )
            endif
            if ( x_4 .eq. xhi_in(mf2) ) then
               xx_4 = xxx_hi(mf2)
            else
               xx_4 = log10( x_4 + xdel )
            endif
            call qchksto( 1, xxx, xxx_hi(mg), xx_3, xx_4 )
            do i = 1, 4
               opvals(i) = opvals(i) + f_xhi
     $              * qchkget( 1, opk(1,i), opk(2,i), opk(3,i) )
            enddo
c					! 3 tables: x4 = x3 (should not happen)
         else if ( x_3 .ge. x_4 ) then
c
            if ( x_4 .eq. xhi_in(mf2) ) then
               xx_4 = xxx_hi(mf2)
            else
               xx_4 = log10( x_4 + xdel )
            endif
            call qchksto( 1, xxx, xxx_hi(mf), xxx_hi(mg), xx_4 )
            do i = 1, 4
               opvals(i) = opvals(i) + f_xhi
     $              * qchkget( 1, opk(1,i), opk(2,i), opk(4,i) )
            enddo
c		   ! 4 tables: interpolate X between two overlapping quadratics
         else
c
            if ( x_3 .eq. xhi_in(mh) ) then
               xx_3 = xxx_hi(mh)
            else
               xx_3 = log10( x_3 + xdel )
            endif
            if ( x_4 .eq. xhi_in(mf2) ) then
               xx_4 = xxx_hi(mf2)
            else
               xx_4 = log10( x_4 + xdel )
            endif
            dixr = ( xx_3 - xxx ) / ( xx_3 - xxx_hi(mg) )
            call quadsto( 1, xxx, xxx_hi(mf), xxx_hi(mg), xx_3 )
            call qchksto( 2, xxx, xxx_hi(mg), xx_3, xx_4 )
            do i = 1, 4
               opvals(i) = opvals(i) + f_xhi * ( quadget( 1, opk(1,i),
     $              opk(2,i), opk(3,i) ) * dixr + qchkget( 2, opk(2,i),
     $              opk(3,i), opk(4,i) ) * ( 1. - dixr ) )
            enddo
c
         endif
c-debug[
c-debug;         if ( fedge .le. 0.0 ) oudebl = max( oudebl , badlogklim )
c-debug;         do m = 1, 3 + min( 1 , mf2 - mh )
c-debug;            if ( .not. abs(opk(m,1)) .le. oudebl ) ichk = 1
c-debug;         enddo
c-debug;         if ( ioudeb .gt. 2 .or. ichk .gt. 0 .or.
c-debug;     $        .not. abs(opact) .le. oudebl ) then
c-debug;            write(6,8415) 'Post-GN93hz-[possibly-high]-X-interp:',
c-debug;     $           mf,mg,mh,mf2,kzf,kzf2,k1,ip,l1,iq(1),iq(2),
c-debug;     $           iq(3),iq(ip+1),z,xh,exC,exO,slt,slr
c-debug;            m = 0
c-debug;            do ix = mf, mf2
c-debug;               if ( ix .le. mg .or. ix .eq. mh .or. ix .eq. mf2 ) then
c-debug;                  m = m + 1
c-debug;                  if ( ix .eq. mf ) then
c-debug;                     tmp = x_1
c-debug;                  else if ( ix .eq. mg ) then
c-debug;                     tmp = x_2
c-debug;                  else if ( ix .eq. mh ) then
c-debug;                     tmp = x_3
c-debug;                  else if ( ix .eq. mf2 ) then
c-debug;                     tmp = x_4
c-debug;                  endif
c-debug;                  write(6,8473) '    ',ix,tmp,(opk(m,i),i=1,4)
c-debug;               endif
c-debug;            enddo
c-debug;            write(6,8473) ' dK=',0,xh,(opvals(i)-opv_prev(i),i=1,4)
c-debug;            write(6,8473) ' +K:',0,xh,(opv_prev(i),i=1,4)
c-debug;            write(6,8473) ' -->',0,xh,(opvals(i),i=1,4)
c-debug;         endif
c-debug;         do i = 1, 4
c-debug;            opv_prev(i) = opvals(i)
c-debug;         enddo
c-debug]
c
      endif
c
c  If the CNO-interpolation is needed, perform it.
c
      if ( max( need_cno , need_user ) .gt. 0 ) then
c
         f_2 = fcn * need_cno
         f_3 = fcon * need_cno
         f_4 = fcnone * need_cno
         f_5 = fu * need_user
c				 ! m is the temporary-opacity-storage X-index
         m = 0
c			  ! loop ix over 'GN93hz'-opacity-shift X-indices
         do ix = mf, mf2
c								    ! ix valid?
            if ( ix .le. mg .or. ix .eq. mh .or. ix .eq. mf2 ) then
c
               m = m + 1
c					! get opacity shifts: loop over Z, T, R
               do kz = kzf, kzf2
c
                  ixm = min( ix , nx_hi(kz) )
c
                  call index_co_deltas( 2, ixm, ix2, ic2, io2 )
                  call index_co_deltas( 3, ixm, ix3, ic3, io3 )
                  call index_co_deltas( 4, ixm, ix4, ic4, io4 )
                  call index_co_deltas( 5, ixm, ix5, ic5, io5 )
c
                  do it = k1, k1 + ip
                     do ir = l1, l1 + iq(it-k1+1)
                        opl(it,ir,kz) = f_2 * co(ix2,ic2,io2,it,ir,kz)
     $                       + f_3 * co(ix3,ic3,io3,it,ir,kz)
     $                       + f_4 * co(ix4,ic4,io4,it,ir,kz)
     $                       + f_5 * co(ix5,ic5,io5,it,ir,kz)
c-debug[
c-debug;                        if ( ioudeb .gt. 8 .or. .not.
c-debug;     $                       abs(opl(it,ir,kz)) .le. oudebl ) then
c-debug;                           write(6,9637) ix, it, ir, kz, opl(it,ir,kz)
c-debug; 9637                      format(' OPAL_K_ONLY cno[ix=',i1,
c-debug;     $                          ']: opl(it=',i2.2,',ir=',i2.2,',kz=',
c-debug;     $                          i2.2,') =',f11.7,$)
c-debug;                           if ( need_cno .gt. 0 ) then
c-debug;                              write(6,9638) '  <--  fcn', f_2, ix2,
c-debug;     $                             ic2, io2, co(ix2,ic2,io2,it,ir,kz)
c-debug; 9638                         format(a,'[',f11.7,'] * co(',i1,',',i1,
c-debug;     $                             ',',i1,',...)[',f11.7,']',$)
c-debug;                              write(6,9638) ' + fcon', f_3, ix3,
c-debug;     $                             ic3, io3, co(ix3,ic3,io3,it,ir,kz)
c-debug;                              write(6,9638) ' + fcnone', f_4, ix4,
c-debug;     $                             ic4, io4, co(ix4,ic4,io4,it,ir,kz)
c-debug;                           endif
c-debug;                           if ( need_user .gt. 0 ) then
c-debug;                              if ( need_cno .le. 0 ) then
c-debug;                                 write(6,9638) '  <--  fu',
c-debug;     $                                f_5, ix5, ic5, io5,
c-debug;     $                                co(ix5,ic5,io5,it,ir,kz)
c-debug;                              else
c-debug;                                 write(6,9638) ' + fu',
c-debug;     $                                f_5, ix5, ic5, io5,
c-debug;     $                                co(ix5,ic5,io5,it,ir,kz)
c-debug;                              endif
c-debug;                           endif
c-debug;                           write(6,'("")')
c-debug;                        endif
c-debug]
                     enddo
                  enddo
c
               enddo
c						! interpolate over Z
               call qzlog4int( zlogd )
c						! interpolate over T and R
               call t6rinterp(slr,slt)
c
            endif
c
         enddo
c
c  Now add the just-computed 'GN93hz' CNO-interpolation opacity shifts and
c  their derivatives to the original opacity and derivative values:
c
c				    ! if 0.0 < X < 0.1 (1st quadratic absent):
c
         if ( mg .eq. 1 .and. mf2 .eq. 3 ) then
c
            call quadsto( 1, xxx, xxx_cno(1), xxx_cno(2), xxx_cno(3) )
            do i = 1, 4
               opvals(i) = opvals(i)
     $              + quadget( 1, opk(1,i), opk(2,i), opk(3,i) )
            enddo
c					! if use only one X-table
         else if ( mf .eq. mh ) then
c
            do i = 1, 4
               opvals(i) = opvals(i) + opk(1,i)
            enddo
c						! if x4 = 0.9 or smaller...
         else if ( mf2 .le. mx_hi - 2 ) then
c						! 3 tables:
            if ( mh .eq. mf2 ) then
c
               call quadsto( 1, xxx, xxx_cno(mf),
     $                       xxx_cno(mg), xxx_cno(mh) )
               do i = 1, 4
                  opvals(i) = opvals(i)
     $                 + quadget( 1, opk(1,i), opk(2,i), opk(3,i) )
               enddo
c						! or 4 tables:
            else
c
               call quad4sto( 1, xxx, xxx_cno(mf),
     $                        xxx_cno(mg), xxx_cno(mh), xxx_cno(mf2) )
               do i = 1, 4
                  opvals(i) = opvals(i)
     $                 + quad4get( 1, opk(1,i), opk(2,i),
     $                             opk(3,i), opk(4,i) )
               enddo
c
            endif
c			           ! 3 tables: interpolate in X using quadratic
         else if ( mh .eq. mf2 ) then
c
            if ( x_3 .eq. xhi_in(mh) ) then
               xx_3 = xxx_cno(mh)
            else
               xx_3 = log10( x_3 + xdel )
            endif
            call qchksto( 1, xxx, xxx_cno(mf), xxx_cno(mg), xx_3 )
            do i = 1, 4
               opvals(i) = opvals(i)
     $              + qchkget( 1, opk(1,i), opk(2,i), opk(3,i) )
            enddo
c					! 3 tables at high-X end of matrix
         else if ( mf .eq. mg ) then
c
            if ( x_3 .eq. xhi_in(mh) ) then
               xx_3 = xxx_cno(mh)
            else
               xx_3 = log10( x_3 + xdel )
            endif
            if ( x_4 .eq. xhi_in(mf2) ) then
               xx_4 = xxx_cno(mf2)
            else
               xx_4 = log10( x_4 + xdel )
            endif
            call qchksto( 1, xxx, xxx_cno(mg), xx_3, xx_4 )
            do i = 1, 4
               opvals(i) = opvals(i)
     $              + qchkget( 1, opk(1,i), opk(2,i), opk(3,i) )
            enddo
c					! 3 tables: x4 < x3 (e.g., if Z > 0.1)
         else if ( x_3 .ge. x_4 ) then
c
            if ( x_4 .eq. xhi_in(mf2) ) then
               xx_4 = xxx_cno(mf2)
            else
               xx_4 = log10( x_4 + xdel )
            endif
            call qchksto( 1, xxx, xxx_cno(mf), xxx_cno(mg), xx_4 )
            do i = 1, 4
               opvals(i) = opvals(i)
     $              + qchkget( 1, opk(1,i), opk(2,i), opk(4,i) )
            enddo
c		   ! 4 tables: interpolate X between two overlapping quadratics
         else
c
            if ( x_3 .eq. xhi_in(mh) ) then
               xx_3 = xxx_cno(mh)
            else
               xx_3 = log10( x_3 + xdel )
            endif
            if ( x_4 .eq. xhi_in(mf2) ) then
               xx_4 = xxx_cno(mf2)
            else
               xx_4 = log10( x_4 + xdel )
            endif
            dixr = ( xx_3 - xxx ) / ( xx_3 - xxx_cno(mg) )
            call quadsto( 1, xxx, xxx_cno(mf), xxx_cno(mg), xx_3 )
            call qchksto( 2, xxx, xxx_cno(mg), xx_3, xx_4 )
            do i = 1,4
               opvals(i) = opvals(i) + quadget( 1, opk(1,i), opk(2,i),
     $              opk(3,i) ) * dixr + qchkget( 2, opk(2,i), opk(3,i),
     $              opk(4,i) ) * ( 1. - dixr )
            enddo
c
         endif
c-debug[
c-debug;         if ( fedge .le. 0.0 ) oudebl = max( oudebl , badlogklim )
c-debug;         do m = 1, 3 + min( 1 , mf2 - mh )
c-debug;            if ( .not. abs(opk(m,1)) .le. oudebl ) ichk = 1
c-debug;         enddo
c-debug;         if ( ioudeb .gt. 1 .or. ichk .gt. 0 .or.
c-debug;     $        .not. abs(opact) .le. oudebl ) then
c-debug;            write(6,8415) 'Post-CNO-interp-X:',
c-debug;     $           mf,mg,mh,mf2,kzf,kzf2,k1,ip,l1,iq(1),iq(2),
c-debug;     $           iq(3),iq(ip+1),z,xh,exC,exO,slt,slr
c-debug;            m = 0
c-debug;            do ix = mf, mf2
c-debug;               if ( ix .le. mg .or. ix .eq. mh .or. ix .eq. mf2 ) then
c-debug;                  m = m + 1
c-debug;                  if ( ix .eq. mf ) then
c-debug;                     tmp = x_1
c-debug;                  else if ( ix .eq. mg ) then
c-debug;                     tmp = x_2
c-debug;                  else if ( ix .eq. mh ) then
c-debug;                     tmp = x_3
c-debug;                  else if ( ix .eq. mf2 ) then
c-debug;                     tmp = x_4
c-debug;                  endif
c-debug;                  write(6,8473) '    ',ix,tmp,(opk(m,i),i=1,4)
c-debug;               endif
c-debug;            enddo
c-debug;            write(6,8473) ' dK=',0,xh,(opvals(i)-opv_prev(i),i=1,4)
c-debug;            write(6,8473) ' +K:',0,xh,(opv_prev(i),i=1,4)
c-debug;            write(6,8473) ' -->',0,xh,(opvals(i),i=1,4)
c-debug;         endif
c-debug]
c
      endif
c
c-debug[
c-debug;      if ( fedge .le. 0.0 ) oudebl = max( oudebl , badlogklim )
c-debug;      if ( ioudeb .gt. 1 .or. ichk .gt. 0 .or.
c-debug;     $     .not. abs(opact) .le. oudebl ) then
c-debug;         koudeb = koudeb + 1
c-debug;         write(6,'(" Final:")')
c-debug;         write(6,8473) ' ==>',0,xh,(opvals(i),i=1,4),' <=='
c-debug;         write(6,'(" ...end of OPAL_K_ONLY."/)')
c-debug;c-test-xdel[
c-debug;c-test-xdel;         if ( mf .ne. mh ) write(6,9387) xh,
c-debug;c-test-xdel;     $        (opdxi(i),i=1,n_xdel_test_m1),
c-debug;c-test-xdel;     $        (xdel_test(i),i=1,n_xdel_test_m1)
c-debug;c-test-xdel; 9387    format('          X=',f10.7,' logK=',8g15.7/
c-debug;c-test-xdel;     $        '                   for delX=',f9.4,7f15.4)
c-debug;c-test-xdel]
c-debug;      endif
c-debug;      oudebl = oudebl_sto
c-debug]
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_last_opac( op, dopt, dopr, doptd, fe, ftre, fze )
c     ================================================================
c
      common/e_opal_z/ opact,dopact,dopacr,dopactd,fedge,ftredge,fzedge
c
      op = opact
      dopt = dopact
      dopr = dopacr
      doptd = dopactd
      fe = fedge
      ftre = ftredge
      fze = fzedge
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_last_xcnou(z,x,xc,xo,slt,slr,fcn,fcon,fcnone,fu)
c     ===============================================================
c
      common /x_opal_z/ z_opal, x_opal, xc_opal, xo_opal, slt_opal,
     $     slr_opal, fcn_opal, fcon_opal, fcnone_opal, fu_opal
c
      z = z_opal
      x = x_opal
      xc = xc_opal
      xo = xo_opal
      slt = slt_opal
      slr = slr_opal
      fcn = fcn_opal
      fcon = fcon_opal
      fcnone = fcnone_opal
      fu = fu_opal
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_opal_z_mix( imix, xiz, n_x, fninz, n_n )
c     =======================================================
c
      dimension xiz(n_x), fninz(n_n)
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      if ( imix .gt. n_zmixes .or. imix .lt. -n_totmix ) then
c
         if ( n_x .gt. 0 ) then
            do i = 1, min( n_x , nel_zmix )
               xiz(i) = xiz_mix(i)
            enddo
            do i = nel_zmix + 1, n_x
               xiz(i) = 0.0
            enddo
         endif
c
         if ( n_n .gt. 0 ) then
            do i = 1, min( n_n , nel_zmix )
               fninz(i) = fninz_mix(i)
            enddo
            do i = nel_zmix + 1, n_n
               fninz(i) = 0.0
            enddo
         endif
c
      else if ( imix .gt. 0 ) then
c
         if ( n_x .gt. 0 ) then
            do i = 1, min( n_x , nel_zmix )
               xiz(i) = xiz_opalmixes(i,imix)
            enddo
            do i = nel_zmix + 1, n_x
               xiz(i) = 0.0
            enddo
         endif
c
         if ( n_n .gt. 0 ) then
            do i = 1, min( n_n , nel_zmix )
               fninz(i) = fninz_opalmixes(i,imix)
            enddo
            do i = nel_zmix + 1, n_n
               fninz(i) = 0.0
            enddo
         endif
c
      else
c
         if ( n_x .gt. 0 ) then
            do i = 1, min( n_x , nel_zmix )
               xiz(i) = xiz_opalGS98(i,-imix)
            enddo
            do i = nel_zmix + 1, n_x
               xiz(i) = 0.0
            enddo
         endif
c
         if ( n_n .gt. 0 ) then
            do i = 1, min( n_n , nel_zmix )
               fninz(i) = fninz_opalGS98(i,-imix)
            enddo
            do i = nel_zmix + 1, n_n
               fninz(i) = 0.0
            enddo
         endif
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_opal_mix_wt( atwt, nwt, atwthhe, nhhe, atz, nz )
c     ===============================================================
c
      dimension atwt(nwt), atwthhe(nhhe), atz(nz)
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      parameter ( n_mix_meteor = 3 )
      double precision xiz_meteor, fninz_meteor
      character*255 cfile_meteor(n_mix_meteor)
      common /c_meteor_mix_opal_z/ xiz_meteor(nel_zmix,n_mix_meteor),
     $     fninz_meteor(nel_zmix,n_mix_meteor),
     $     nuc_charge_opalmixes(nel_zmix), cfile_meteor
      save /c_meteor_mix_opal_z/
c
      parameter ( atwt_H = 1.0079, atwt_He = 4.0026 )
c
      if ( nwt .gt. 0 ) then
         do i = 1, min( nwt , nel_zmix )
            atwt(i) = atwt_opalGS98(i)
         enddo
      endif
c
      if ( nhhe .gt. 0 ) then
         atwthhe(1) = atwt_H
         if ( nhhe .gt. 1 ) then
            atwthhe(2) = atwt_He
         endif
      endif
c
      if ( nz .gt. 0 ) then
         do i = 1, min( nz , nel_zmix )
            atz(i) = nuc_charge_opalmixes(i)
         enddo
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine set_opal_list_level( list_level )
c     ============================================
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c
      level_list = max( 0 , list_level )
c
      do i = -n_zmixes, n_totmix
         list_gn(i) = 0
      enddo
c
      return
      end
c
c******************************************************************************
c
      subroutine set_opal_list_unit( list_iu )
c     ========================================
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c
      if ( list_iu .lt. 0 .or.
     $     list_iu .eq. 5 .or. list_iu .gt. 99 ) then
         iu_list = 6
      else
         iu_list = list_iu
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine set_opal_dir( cdirin )
c     =================================
c
      character*(*) cdirin
c
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c===
      call chk_dir_name( cdirin, copdir, kope )
c
      if ( kope .lt. 0 ) stop
     $     ' STOP -- SET_OPAL_DIR Error: bad directory name. '
c
      return
      end
c
c******************************************************************************
c
      subroutine set_mol_dir( cdirin )
c     ================================
c
      character*(*) cdirin
c
      character*255 cfile_alex
      common /c_filename_alex/ need_alex_dir, cfile_alex
      save /c_filename_alex/
c===
      call chk_dir_name( cdirin, cfile_alex, kope )
c
      if ( kope .lt. 0 ) stop
     $     ' STOP -- SET_MOL_DIR Error: bad directory name. '
c
      need_alex_dir = 0
c
      return
      end
c
c******************************************************************************
c
      subroutine set_cond_dir( cdirin )
c     =================================
c
      character*(*) cdirin
c
      parameter ( ndef_cond = 3 )
c
      character*255 cfile_cond
      character*80 cdef_cond(ndef_cond)
      common /c_filename_cond/ need_cond_dir, cfile_cond, cdef_cond
      save /c_filename_cond/
c===
      call chk_dir_name( cdirin, cfile_cond, kope )
c
      if ( kope .lt. 0 ) stop
     $     ' STOP -- SET_COND_DIR Error: bad directory name. '
c
      need_cond_dir = 0
c
      return
      end
c
c******************************************************************************
c
      subroutine read_basic_opal_opac( iu, z, cf_hz, ofebrack, cf_ofe )
c     =================================================================
c
      character*(*) cf_hz, cf_ofe
c
      if ( iu .ge. 0 .and. iu .lt. 7 ) then
         i_u = 7
      else
         i_u = min( iu , 96 )
      endif
c
      if ( cf_hz .eq. ' ' .or. cf_hz .eq. 'GN93hz' ) then
         khighz = 1
      else
         khighz = -1
         call set_altmix_main_file( cf_hz )
      endif
c
      if ( ofebrack .ne. 0.0 ) then
         khighz = 5 * khighz
         if ( khighz .gt. 0 ) then
            call set_ofe_file( cf_ofe )
         else
            call set_altmix_ofe_file( cf_ofe )
         endif
      endif
c
      call readzexco( -9, -1.0, z, -1.0, khighz, i_u, ofebrack )
c
      return
      end
c
c******************************************************************************
c
      subroutine read_extended_opac( i_u, z, cf_hz, ofebrack, cf_ofe,
     $                               i_alex, i_cond, i_cno, cf_user )
c     ===============================================================
c
      character*(*) cf_hz, cf_ofe, cf_user
c					      ! get a valid Fortran unit number
      if ( i_u .ge. 0 .and. i_u .lt. 7 ) then
         iu = 7
      else
         iu = min( i_u , 96 )
      endif
c							  ! GN93 case or not?
      if ( cf_hz .eq. ' ' .or. cf_hz .eq. 'GN93hz' ) then
         khighz = 1
      else
         khighz = -1
         call set_altmix_main_file( cf_hz )
      endif
c					! if non-zero [O/Fe]: reset khighz
      if ( ofebrack .ne. 0.0 ) then
         khighz = 5 * khighz
         if ( khighz .gt. 0 ) then
            call set_ofe_file( cf_ofe )
         else
            call set_altmix_ofe_file( cf_ofe )
         endif
      endif
c					! if CNO-interp: reset khighz
      if ( i_cno .ne. 0 ) then
         if ( khighz .gt. 0 ) then
            khighz = khighz + 10
         else
            khighz = khighz - 10
         endif
      endif
c					! if d_KAPPA_user: reset khighz
      if ( cf_user .ne. ' ' ) then
         call set_cno_files( ' ', ' ', ' ', ' ', cf_user )
         if ( khighz .gt. 0 ) then
            khighz = khighz + 20
         else
            khighz = khighz - 20
         endif
      endif
c
c  Read in the OPAL opacity files:
c
      call readzexco( -9, -1.0, z, -1.0, khighz, iu, ofebrack )
c
c  Possibly read molecular opacities:
c
      call read_best_mol( iu, i_alex, cf_hz, ofebrack )
c
c  Read conductive opacities, if input flag so indicates;
c
      if ( iabs( i_cond ) .gt. 1 ) then
         call read_cond_pot( iu )
      else if ( i_cond .ne. 0 ) then
         call readcond( iu )
      endif
c						  ! set conductive-opacity flag
      call set_cond_use( min(1,max(0,i_cond)), 99 )
c
      return
      end
c
c******************************************************************************
c
      subroutine set_ofe_file( cfileofe )
c     ===================================
c
      character*(*) cfileofe
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c===
      last = lnblnk( cfileofe )
      ibeg = max( 1 , non_blank_begin(cfileofe) )
c							! blank input --> W95hz
      if ( last .lt. ibeg ) then
         cfile_opalmixes(n_zmixes) = cfile_opalmixes(4)
         return
      endif
c
      if ( level_err .gt. 0 ) then
c
         if ( last - ibeg .ge. 8 ) then
            write(6,10) last - ibeg + 1, cfileofe(ibeg:last)
 10         format(' WARNING: length',i5,
     $           ' exceeds 8 for filename for khighz = 5:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_OFE_FILE Error: name too long. '
         endif
c
         iblank = num_blanks_contained( cfileofe )
c
         if ( iblank .gt. 0 ) then
            write(6,20) iblank, cfileofe(ibeg:last)
 20         format(' WARNING:',i5,' blanks contained in filename',
     $           ' for khighz = -5:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_OFE_FILE Error: blanks in name. '
         endif
c
      endif
c
      cfile_opalmixes(n_zmixes) = cfileofe(ibeg:)
c
      return
      end
c
c******************************************************************************
c
      subroutine set_altmix_ofe_file( cfileofe )
c     ==========================================
c
      character*(*) cfileofe
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c===
      last = lnblnk( cfileofe )
c
      ibeg = max( 1 , non_blank_begin(cfileofe) )
c						  ! blank input --> default
      if ( last .lt. ibeg ) then
         cfile_opalGS98(n_zmixes) = ' '
         return
      endif
c
      if ( level_err .gt. 0 ) then
c
         if ( last - ibeg .ge. 255 ) then
            write(6,10) last - ibeg + 1, cfileofe(ibeg:last)
 10         format(' WARNING: length',i5,
     $           ' exceeds 255 for filename for khighz = -5:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_ALTMIX_OFE_FILE Error: name too long. '
         endif
c
         iblank = num_blanks_contained( cfileofe )
c
         if ( iblank .gt. 0 ) then
            write(6,20) iblank, cfileofe(ibeg:last)
 20         format(' WARNING:',i5,' blanks contained in filename',
     $           ' for khighz = -5:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_ALTMIX_OFE_FILE Error: blanks in name. '
         endif
c
      endif
c
      cfile_opalGS98(n_zmixes) = cfileofe(ibeg:)
c
      return
      end
c
c******************************************************************************
c
      subroutine set_meteor_mix_file( cfilemet )
c     ==========================================
c
      character*(*) cfilemet
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c===
      last = lnblnk( cfilemet )
c
      ibeg = max( 1 , non_blank_begin(cfilemet) )
c
      if ( level_err .gt. 0 ) then
c
         if ( last - ibeg .ge. 255 ) then
            write(6,10) last - ibeg + 1, cfilemet(ibeg:last)
 10         format(' WARNING: length',i5,
     $           ' exceeds 255 for filename for meteor-mix:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_METEOR_MIX_FILE Error: name too long. '
         endif
c
         iblank = num_blanks_contained( cfilemet )
c
         if ( iblank .gt. 0 ) then
            write(6,20) iblank, cfilemet(ibeg:last)
 20         format(' WARNING:',i5,' blanks contained in filename',
     $           ' for khighz = -5:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_METEOR_MIX_FILE Error: blanks in name. '
         endif
c
      endif
c
      cfile_opalGS98(0) = cfilemet(ibeg:)
c
      return
      end
c
c******************************************************************************
c
      subroutine set_altmix_main_file( cfile_hz )
c     ===========================================
c
      character*(*) cfile_hz
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      common /alt_change_opal_z/ main_alt_change, iulow, khighz_in,
     $     ofebrack_in
      save /alt_change_opal_z/
c===
      last = lnblnk( cfile_hz )
c
      ibeg = max( 1 , non_blank_begin(cfile_hz) )
c
      if ( level_err .gt. 0 ) then
c
         if ( last - ibeg .ge. 255 ) then
            write(6,10) last - ibeg + 1, cfile_hz(ibeg:last)
 10         format(' WARNING: length',i5,
     $           ' exceeds 255 for filename for khighz = -1:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_ALTMIX_MAIN_FILE Error: name too long. '
         endif
c
         iblank = num_blanks_contained( cfile_hz )
c
         if ( iblank .gt. 0 ) then
            write(6,20) iblank, cfile_hz(ibeg:last)
 20         format(' WARNING:',i5,' blanks contained in filename',
     $           ' for khighz = -5:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_ALTMIX_MAIN_FILE Error: blanks in name '
         endif
c
      endif
c
      if ( last .le. 0 ) then
         cfile_opalGS98(1) = 'GS98hz'
         main_alt_change = 2
      else
         cfile_opalGS98(1) = cfile_hz(ibeg:)
         main_alt_change = 1
      endif
c
      last = lnblnk( cfile_opalGS98(1) )
      cfile_opalGS98(2) = cfile_opalGS98(1)(:last) // '_OFe.3_Alrd96a2'
      cfile_opalGS98(3) = cfile_opalGS98(1)(:last) // '_OFe.4_C95'
      cfile_opalGS98(4) = cfile_opalGS98(1)(:last) // '_OFe.5_W95'
c
      return
      end
c
c******************************************************************************
c
      subroutine set_cno_files( cf_hz, cf_c, cf_o, cf_n, cf_user )
c     ============================================================
c
      character*(*) cf_hz, cf_c, cf_o, cf_n, cf_user
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      character*80 cdef_CNO_ext(n_cnobeg:n_totmix)
      common /ext_CNO_opal_z/ len_def_CNO_ext(n_cnobeg:n_totmix),
     $     cdef_CNO_ext
      save /ext_CNO_opal_z/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      parameter ( nbegp1 = n_cnobeg + 1, nbegp2 = n_cnobeg + 2 )
c===
      iwarn = max( 2 - level_err , 0 )
      l_max = 0
c			! this initialization just prevents compiler warnings:
      l_hz = 0
c
      do k = n_cnobeg, n_totmix
c
         if ( k .eq. n_cnobeg ) then
            last = lnblnk( cf_hz )
            ibeg = max( 1 , non_blank_begin(cf_hz) )
            cfile_opalGS98(k) = cf_hz(ibeg:)
         else if ( k .eq. nbegp1 ) then
            last = lnblnk( cf_c )
            ibeg = max( 1 , non_blank_begin(cf_c) )
            cfile_opalGS98(k) = cf_c(ibeg:)
         else if ( k .eq. nbegp2 ) then
            last = lnblnk( cf_o )
            ibeg = max( 1 , non_blank_begin(cf_o) )
            cfile_opalGS98(k) = cf_o(ibeg:)
         else if ( k .eq. n_totmix ) then
            last = lnblnk( cf_user )
            ibeg = max( 1 , non_blank_begin(cf_user) )
            cfile_opalGS98(k) = cf_user(ibeg:)
         else
            last = lnblnk( cf_n )
            ibeg = max( 1 , non_blank_begin(cf_n) )
            cfile_opalGS98(k) = cf_n(ibeg:)
         endif
c
         if ( k .eq. n_cnobeg ) then
            l_hz = last - ibeg + 1
         else if ( last .eq. 0 .and. l_hz .gt. 0 ) then
            cfile_opalGS98(k) =
     $           cfile_opalGS98(n_cnobeg)(:min(l_hz,255)) //
     $           cdef_CNO_ext(k)
            last = l_hz + len_def_CNO_ext(k)
         else if ( last .gt. 0 .and. l_hz .eq. 0 .and.
     $           iwarn .eq. 0 ) then
            write(6,10)
 10         format(' WARNING: SET_CNO_FILES: blank  cfile_hz',
     $           '  but other input filename(s) non-blank')
            iwarn = iwarn + 1
         endif
c
         l_max = max( l_max , last - ibeg + 1 )
c
      enddo
c
      if ( l_max .gt. 255 .and. level_err .gt. 0 ) then
         write(6,20) l_max
 20      format(' WARNING: SET_CNO_FILES: largest filename length',i5,
     $        ' exceeds 255')
         if ( level_err .ge. 2 ) stop
     $        ' STOP -- SET_CNO_FILES Error: filename too long. '
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine set_cno_ext( ie, ce_hz, ce_c, ce_o, ce_n, ce_u )
c     ===========================================================
c
      character*(*) ce_hz, ce_c, ce_o, ce_n, ce_u
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*80 cdef_CNO_ext(n_cnobeg:n_totmix)
      common /ext_CNO_opal_z/ len_def_CNO_ext(n_cnobeg:n_totmix),
     $     cdef_CNO_ext
      save /ext_CNO_opal_z/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      parameter ( nbegp1 = n_cnobeg + 1, nbegp2 = n_cnobeg + 2 )
c===
      l_max = 0
c
      do k = n_cnobeg, n_totmix
c
         ibeg = 1
         if ( k .eq. n_cnobeg ) then
            last = lnblnk( ce_hz )
            if ( last .gt. 0 ) then
               ibeg = non_blank_begin(ce_hz)
               cdef_CNO_ext(k) = ce_hz(ibeg:)
            endif
         else if ( k .eq. nbegp1 ) then
            last = lnblnk( ce_c )
            if ( last .gt. 0 ) then
               ibeg = non_blank_begin(ce_c)
               cdef_CNO_ext(k) = ce_c(ibeg:)
            endif
         else if ( k .eq. nbegp2 ) then
            last = lnblnk( ce_o )
            if ( last .gt. 0 ) then
               ibeg = non_blank_begin(ce_o)
               cdef_CNO_ext(k) = ce_o(ibeg:)
            endif
         else if ( k .eq. n_totmix ) then
            last = lnblnk( ce_u )
            if ( last .gt. 0 ) then
               ibeg = non_blank_begin(ce_u)
               cdef_CNO_ext(k) = ce_u(ibeg:)
            endif
         else
            last = lnblnk( ce_n )
            if ( last .gt. 0 ) then
               ibeg = non_blank_begin(ce_n)
               cdef_CNO_ext(k) = ce_n(ibeg:)
            endif
         endif
c
         if ( last .gt. 0 ) then
            len_def_CNO_ext(k) = last - ibeg + 1
            l_max = max( len_def_CNO_ext(k) , l_max )
         else if ( ie .eq. k .or. ie + n_zmixes .eq. k ) then
            cdef_CNO_ext(k) = ' '
            len_def_CNO_ext(k) = 0
         endif
c
      enddo
c     
      if ( l_max .gt. 80 .and. level_err .gt. 0 ) then
         write(6,20) l_max
 20      format(' WARNING: SET_CNO_EXT: largest extension length',i5,
     $        ' exceeds 80')
         if ( level_err .ge. 2 ) stop
     $        ' STOP -- SET_CNO_EXT Error: extension too long. '
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine set_cond_file( cfilecond, i_full_path )
c     ==================================================
c
      character*(*) cfilecond
c
      parameter ( ndef_cond = 3 )
c
      character*255 cfile_cond
      character*80 cdef_cond(ndef_cond)
      common /c_filename_cond/ need_cond_dir, cfile_cond, cdef_cond
      save /c_filename_cond/
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c===
      last = lnblnk( cfilecond )
c
      ibeg = max( 1 , non_blank_begin(cfilecond) )
c
      if ( i_full_path .gt. 0 ) then
         need_cond_dir = 0
      else
         need_cond_dir = 1
      endif
c
      if ( level_err .gt. 0 ) then
c
         if ( last - ibeg .ge. 255 ) then
            write(6,10) last - ibeg + 1, cfilecond(ibeg:last)
 10         format(' WARNING: length',i5,
     $           ' exceeds 255 for H&L-Kcond filename:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_COND_FILE Error: name too long. '
         endif
c
         iblank = num_blanks_contained( cfilecond )
c
         if ( iblank .gt. 0 ) then
            write(6,20) iblank, cfilecond(ibeg:last)
 20         format(' WARNING:',i5,' blanks contained in',
     $           ' H&L-Kcond filename:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_COND_FILE Error: blanks in name. '
         endif
c
      endif
c
      cfile_cond = cfilecond(ibeg:)
c
      kavail_cond = 0
c
      return
      end
c
c******************************************************************************
c
      subroutine set_cond_use( kcond, kreplace_itoh )
c     ===============================================
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      if ( kcond .gt. -9 ) then
         kuse_cond = max( 0 , min( 1 , kcond ) )
      else if ( kcond .gt. -99 ) then
         kuse_cond = 1
      endif
c
      if ( kreplace_itoh .gt. -9 ) then
         itoh_replace = max( -1 , min( 99 , kreplace_itoh ) )
      else if ( kreplace_itoh .gt. -99 ) then
         itoh_replace = 99
      endif
c
      kdo_cond = kavail_cond * kuse_cond
c
      return
      end
c
c******************************************************************************
c
      subroutine set_cond_inflags( kcond_fix, kcond_gap, kcond_have )
c     ===============================================================
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      if ( kcond_fix .gt. -9 ) then
         ifix_h_cond_next = max( 0 , min( 1 , kcond_fix ) )
      else if ( kcond_fix .gt. -99 ) then
         ifix_h_cond_next = 1
      else
         ifix_h_cond_next = ifix_h_cond
      endif
c
      if ( kcond_gap .gt. -9 ) then
         itoh_gap_next = max( 0 , min( 1 , kcond_gap ) )
      else if ( kcond_gap .gt. -99 ) then
         itoh_gap_next = 1
      else
         itoh_gap_next = itoh_gap
      endif
c
      if ( kcond_have .gt. -9 ) then
         kavail_cond = max( 0 , min( 1 , kcond_have ) ) * kavail_cond
      else if ( kcond_have .gt. -99 .and.
     $        ( ifix_h_cond_next .ne. ifix_h_cond .or.
     $        itoh_gap_next .ne. itoh_gap ) ) then
         kavail_cond = 0
      endif
c
      kdo_cond = kavail_cond * kuse_cond
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_cond_use( kcond, kcond_avail, kreplace_itoh )
c     ============================================================
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      kcond = kuse_cond
      kcond_avail = kavail_cond
      kreplace_itoh = min( itoh_replace ,
     $                     itoh_replace_max(kavail_cond) )
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_cond_inflags( kc_fix, kc_gap, kc_fix_n, kc_gap_n )
c     =================================================================
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      kc_fix = ifix_h_cond
      kc_gap = itoh_gap
      kc_fix_n = ifix_h_cond_next
      kc_gap_n = itoh_gap_next
c
      return
      end
c
c******************************************************************************
c
      subroutine set_ferg_user( cbeg_ferg )
c     =====================================
c
      character*(*) cbeg_ferg
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      if ( cbeg_ferg .eq. ' ' ) then
c
         ctype_ferg(ntyp1_ferg) = ' '
         ltype_ferg(ntyp1_ferg) = 0
         return
c
      endif
c
      last = lnblnk( cbeg_ferg )
      ibeg = max( 1 , non_blank_begin(cbeg_ferg) )
c
      if ( level_err .gt. 0 ) then
c
         if ( last - ibeg .ge. 80 ) then
            write(6,10) last - ibeg + 1, cbeg_ferg(ibeg:last)
 10         format(' WARNING: length',i4,' exceeds 80 for user-',
     $           'supplied Ferguson 2005 file-beginning:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_FERG_USER Error: name too long. '
         endif
c
         iblank = num_blanks_contained( cbeg_ferg )
c
         if ( iblank .gt. 0 ) then
            write(6,20) iblank, cbeg_ferg(ibeg:last)
 20         format(' WARNING:',i4,' blanks contained in user-',
     $           'supplied Ferguson 2005 file-beginning:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_FERG_USER Error: blanks in name. '
         endif
c
      endif
c
      ltype_ferg(ntyp1_ferg) = min( 80 , last - ibeg + 1 )
      ctype_ferg(ntyp1_ferg) = cbeg_ferg(ibeg:)
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_ferg_user( cbeg_ferg )
c     =====================================
c
      character*(*) cbeg_ferg
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      cbeg_ferg = ctype_ferg(ntyp1_ferg)
c
      return
      end
c
c******************************************************************************
c
      subroutine set_ferg_acc( iacc )
c     ===============================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_prev_ferg/ zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $     zlp2_ferg, xp2_ferg, i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
      save /c_prev_ferg/
c
      iaccin = max( 0 , min( 1 , iacc ) )
c						! switch accuracy flag
      if ( iaccin .ne. iacc_ferg ) then
c
         iacc_ferg = iaccin
c			! clear any cached Z,X-interpolated Ferguson opacities
         zlogp_ferg = -9.0
         xp_ferg = -9.0
         zlp1_ferg = -9.0
         xp1_ferg = -9.0
         zlp2_ferg = -9.0
         xp2_ferg = -9.0
         i1p_ferg = -1
         i4p_ferg = -9
         j1p_ferg = -1
         j4p_ferg = -9
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_ferg_acc( iacc )
c     ===============================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      iacc = iacc_ferg
c
      return
      end
c
c******************************************************************************
c
      subroutine set_alex_file( cfilealex, i_full_path )
c     ==================================================
c
      character*(*) cfilealex
c
      character*255 cfile_alex
      common /c_filename_alex/ need_alex_dir, cfile_alex
      save /c_filename_alex/
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c===
      last = lnblnk( cfilealex )
c
      ibeg = max( 1 , non_blank_begin(cfilealex) )
c
      if ( i_full_path .gt. 0 ) then
         need_alex_dir = 0
      else
         need_alex_dir = 1
      endif
c
      if ( level_err .gt. 0 ) then
c
         if ( last - ibeg .ge. 255 ) then
            write(6,10) last - ibeg + 1, cfilealex(ibeg:last)
 10         format(' WARNING: length',i5,
     $           ' exceeds 255 for Alexander filename:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_ALEX_FILE Error: name too long. '
         endif
c
         iblank = num_blanks_contained( cfilealex )
c
         if ( iblank .gt. 0 ) then
            write(6,20) iblank, cfilealex(ibeg:last)
 20         format(' WARNING:',i5,' blanks contained in',
     $           ' Alexander filename:'/' ',a)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- SET_ALEX_FILE Error: blanks in name. '
         endif
c
      endif
c
      cfile_alex = cfilealex(ibeg:)
c
      return
      end
c
c******************************************************************************
c
      subroutine set_alex_use( kalex )
c     ================================
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      if ( kalex .le. -99 ) then
         return
      else if ( kalex .le. -9 ) then
         kuse_alex = 1
      else
         kuse_alex = max( -4 , min( 4 , kalex ) )
      endif
      kold = kdo_alex
      kdo_alex = min( 1 , kavail_alex ) * kuse_alex
c					 ! if just switched on, make sure low-T
c				      ! high-RHO OPAL limit includes switchover
      if ( kold .le. 0 .and. kdo_alex .gt. 0 ) then
         if ( isw_rho_alex .gt. 0 ) then
            call set_logt_rhosw_alex( -99.0, -99.0 )
         else
            call set_logt6_limits( -99.0, -99.0, -99.0, -99.0 )
            call set_logr_limits( -99.0, -99.0, -99.0, -99.0 )
         endif
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine set_alex_do_rhosw( irhosw )
c     ======================================
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      if ( irhosw .le. -99 ) return
c
      kold = isw_rho_alex
      if ( irhosw .ne. 0 ) then
         isw_rho_alex = 1
      else
         isw_rho_alex = 0
      endif
c			! if just switched on, check its extent to low T
c
      if ( kdo_alex .gt. 0 .and. isw_rho_alex .gt. kold )
     $     call set_logt_rhosw_alex( -99.0, -99.0 )
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_alex_use( kalex, kalex_avail, itype )
c     ====================================================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      kalex = kuse_alex
      kalex_avail = kavail_alex
c
      if ( kavail_alex .le. 1 ) then
         itype = isw_rho_alex
      else if ( itype_ferg .ge. ntyp1_ferg ) then
         itype = 99
      else
         itype = itype_ferg
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_khighz_ofe( khighz_used, ofebrack_used )
c     =======================================================
c
      common /alt_change_opal_z/ main_alt_change, iulow, khighz_in,
     $     ofebrack_in
      save /alt_change_opal_z/
c
      khighz_used = khighz_in
      ofebrack_used = ofebrack_in
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_opal_file_used( itype, cf_used )
c     ===============================================
c
c  itype = -1: OPAL directory
c           0: meteoritic-mix file (this file may not actually exist)
c           1: main mix file (used if khighz is non-zero)
c           2: Alexander opacities file, including directory
c           3: conductive opacities file, including directory
c           4: GN93hz file (needed to correct Gz???x?? if khighz non-zero)
c           5: non-zero [O/Fe] file
c           6: CNO-interp main mix file
c           7: CNO-interp C --> N file
c           8: CNO-interp CO --> N file
c           9: CNO-interp CNO --> Ne file
c          10: user-mix file
c
      character*(*) cf_used
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c
      cf_used = cfile_opal_used( max( -1 , min( n_totmix , itype ) ) )
c
      return
      end
c
c******************************************************************************
c
      subroutine set_xhi( kxhi )
c     ==========================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mx_hi_nz=mx_hi*nz )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c						! set high-X flag value
      kuse_xhi = max( 0 , min( 2 , kxhi ) )
      if ( kavail_xhi .le. 0 ) then
         kdo_xhi = 0
      else
         kdo_xhi = kuse_xhi
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_xhi( kxhi, kavail )
c     ==================================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mx_hi_nz=mx_hi*nz )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c						! return high-X flag value
      kxhi = kuse_xhi
c						! return availability flag
      kavail = max( 0 , min( 1 , kavail_xhi ) )
c
      return
      end
c
c******************************************************************************
c
      subroutine set_cno_interp( kcno, kuser )
c     ========================================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mx_hi_nz=mx_hi*nz )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c						! set CNO-interpolation flags
      kuse_cno = max( min( kcno , 1 ) , 0 )
      kuse_user = max( min( kuser , 1 ) , 0 )
      kdo_cno = kuse_cno * kavail_cno
      kdo_user = kuse_user * kavail_user
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_cno_interp( kcno, kuser, kcno_avail, kuser_avail )
c     =================================================================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mx_hi_nz=mx_hi*nz )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c					! return CNO-interpolation flags
      kcno = kuse_cno
      kuser = kuse_user
      kcno_avail = kavail_cno
      kuser_avail = kavail_user
c
      return
      end
c
c******************************************************************************
c
      subroutine set_err_check( level )
c     =================================
c						! set error-checking level
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      level_err = max( 0 , min( 3 , level ) )
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_err_check( level )
c     =================================
c						! return error-checking level
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      level = level_err
c
      return
      end
c
c******************************************************************************
c
      subroutine set_logt6_limits( vlo, dvlo, vhi, dvhi )
c     ===================================================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_tsw_ferg/ slt_max_ferg, sltswlo_ferg_def,
     $     sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $     sltswmid_ferg, dltsw2inv_ferg
      save /c_tsw_ferg/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c===						! set T,R-values, if necessary
      if ( init_trvals .le. 0 ) call get_trvals
c
c  Set the logT6 limits, according to the input values; by default, make
c  1-grid-point extrapolation beyond the matrix edge just within the limits
c  [sharpest allowed extrapolation cutoff is 1.E-6 (no extrapolation)].
c
      if ( vlo .gt. -90. ) sltlo = max( alt(1) , min( alt(nt) , vlo ) )
c
c			     ! if molecular opacity-inclusion is set, make sure
c			     ! low-T OPAL limit is low enough for switchover
      if ( kdo_alex .gt. 0 ) then
         if ( kavail_alex .eq. 1 ) then
            sltlo = max( alt(1) , min( sltlo , fltswlo_alex - 6. ) )
         else
            sltlo = max( alt(1) , min( sltlo , sltswlo_ferg ) )
         endif
      endif
c
      if ( dvlo .lt. -90. ) then
         dltlo_inv = max( dltlo_inv ,
     $        1. / ( sltlo - alt(1) + 0.999999 / dfs(1) ) )
      else if ( dvlo .lt. 0. ) then
         dltlo_inv = dfs(1) * 0.999999
      else
         dltlo_inv = 1. / min( max( dvlo , 0.000001 ) ,
     $        sltlo - alt(1) + 0.999999 / dfs(1) )
      endif
c	    ! if Alexander opacity-inclusion is set, make sure any high-RHO
c	    ! switchover from Alexander to OPAL does not extend too low in T
c
      if ( kdo_alex .gt. 0 .and.
     $     kavail_alex .eq. 1 .and. isw_rho_alex .gt. 0 )
     $     call set_logt_rhosw_alex( -99.0, -99.0 )
c
      if ( vhi .gt. -90. ) slthi = max( alt(1) , min( alt(nt) , vhi ) )
c
      if ( dvhi .lt. -90. ) then
         dlthi_inv = max( dlthi_inv ,
     $        1. / ( alt(nt) - slthi + 0.999999 / dfs(nt) ) )
      else if ( dvhi .lt. 0. ) then
         dlthi_inv = dfs(nt) * 0.999999
      else
         dlthi_inv = 1. / min( max( dvhi , 0.000001 ) ,
     $        alt(nt) - slthi + 0.999999 / dfs(nt) )
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine set_logr_limits( vlo, dvlo, vhi, dvhi )
c     ==================================================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c===						! set T,R-values, if necessary
      if ( init_trvals .le. 0 ) call get_trvals
c
c  Set the logR limits, according to the input values; by default, make
c  1-grid-point extrapolation beyond the matrix edge just within the limits
c  [sharpest allowed extrapolation cutoff is 1.E-6 (no extrapolation)].
c
      if ( vlo .gt. -90. ) slrlo = max( alr(1) , min( alr(nr) , vlo ) )
c
      if ( dvlo .lt. -90. ) then
         dlrlo_inv = max( dlrlo_inv ,
     $        1. / ( slrlo - alr(1) + 0.999999 / dfsr(1) ) )
      else if ( dvlo .lt. 0. ) then
         dlrlo_inv = dfsr(1) * 0.999999
      else
         dlrlo_inv = 1. / min( max( dvlo , 0.000001 ) ,
     $        slrlo - alr(1) + 0.999999 / dfsr(1) )
      endif
c
      if ( vhi .gt. -90. ) slrhi = max( alr(1) , min( alr(nr) , vhi ) )
c
c		! if Alexander opacity-inclusion is set, make sure OPAL opacity
c				   ! is calculated throughout switchover region
      if ( kdo_alex .gt. 0 .and. kavail_alex .eq. 1 ) then
         if ( isw_rho_alex .le. 0 ) then
            slrhi = max( slrhi , min( alr(nr) , flrhoswhi_alex
     $           - 1. / dfsr(nr) - 3. * ( fltswlo_alex - 6. ) ) )
         else
            slrhi = max( slrhi , min( alr(nr) , flrhoswhi_alex
     $           - 1. / dfsr(nr) - 3. * ( fltswlo_r_alex - 6. ) ) )
         endif
      endif
c
      if ( dvhi .lt. -90. ) then
         dlrhi_inv = max( dlrhi_inv ,
     $        1. / ( alr(nr) - slrhi + 0.999999 / dfsr(nr) ) )
      else if ( dvhi .lt. 0. ) then
         dlrhi_inv = dfsr(nr) * 0.999999
      else
         dlrhi_inv = 1. / min( max( dvhi , 0.000001 ) ,
     $        alr(nr) - slrhi + 0.999999 / dfsr(nr) )
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine reset_z_limits( vlo, dvlo, vhi, dvhi )
c     =================================================
c
      parameter ( small_1m6=1.e-6, small_m1m6=-1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c				! if no opacities were read in, cannot reset!
c
      if ( itime .ne. 12345678 ) return
c
      if ( min( vlo , vhi ) .gt. small_m1m6 ) then
         zlow = max( zsto(1) , min( vlo , vhi , zsto(numz) ) )
         zhigh = min( zsto(numz) , max( vhi , vlo , zsto(1) ) )
      else if ( vlo .gt. small_m1m6 ) then
         zlow = max( zsto(1) , min( vlo , zhigh , zsto(numz) ) )
      else if ( vhi .gt. small_m1m6 ) then
         zhigh = min( zsto(numz) , max( vhi , zlow , zsto(1) ) )
      endif
c
      if ( dvlo .gt. small_m1m6 ) then
         if ( zlow .le. zsto(1) + zacc(1) ) then
            zlo_ex = zlow - max( dvlo , zacc(1) )
         else
            zlo_ex = zlow - max( dvlo , zacc(numz) )
         endif
      else if ( zlow .le. zsto(1) + zacc(1) ) then
         zlo_ex = min( zlo_ex , zlow - zacc(1) )
      else
         zlo_ex = min( zlo_ex , zlow - zacc(numz) )
      endif
c
      if ( dvhi .gt. small_m1m6 ) then
         zhi_ex = zhigh + max( dvhi , zacc(numz) )
      else
         zhi_ex = max( zhi_ex , zhigh + zacc(numz) )
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_logt6_limits( vlo, dvlo, vhi, dvhi )
c     ===================================================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c===						! set T,R-values, if necessary
      if ( init_trvals .le. 0 ) call get_trvals
c
      vlo = sltlo
      dvlo = 1. / dltlo_inv
      vhi = slthi
      dvhi = 1. / dlthi_inv
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_logr_limits( vlo, dvlo, vhi, dvhi )
c     ==================================================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c===						! set T,R-values, if necessary
      if ( init_trvals .le. 0 ) call get_trvals
c
      vlo = slrlo
      dvlo = 1. / dlrlo_inv
      vhi = slrhi
      dvhi = 1. / dlrhi_inv
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_z_limits( nzmax, zmin, zmax )
c     ============================================
c
c  Returns NZ (maximum allowed stored Z-values) and Z-limits (0.0 and 0.1)
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mz=8, mz_m1=mz-1, mz_m2=mz-2, mzhi=11, mzal=13,
     $     nzm=mzal+1, nadd_zavail=nzm-mz )
c===
      nzmax = min( nz , nzm )
      zmin = 0.0
      zmax = 0.1
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_z_use( nzuse, zlo, zmid, zhi, zloex, zhiex )
c     ===========================================================
c
      parameter ( small_m1m8=-1.e-8 )
c
c  Returns the current values of numz, zlow, zmiddle, zhigh, zlo_ex, zhi_ex
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c===
      if ( itime .ne. 12345678 ) then
         nzuse = 0
         zlo = 0.
         zmid = 0.02
         zhi = 0.1
         zloex = small_m1m8
         zhiex = 0.12
      else
         nzuse = numz
         zlo = zlow
         zmid = zmiddle
         zhi = zhigh
         zloex = zlo_ex
         zhiex = zhi_ex
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_z_array( kzstart, karraystart, zarray, narray )
c     ==============================================================
c
c  Returns Z-values from zsto(), starting with element kzstart, in the
c  array zarray(narray), starting with element karraystart; any excess
c  elements in zarray() after nums is reached are filled with values of -1.
c
      dimension zarray(narray)
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c===
      if ( itime .ne. 12345678 ) then
         nzuse = 0
      else
         nzuse = numz
      endif
c
      k_z = max( kzstart , 1 )
      k_a = karraystart
      do while ( k_z .le. nzuse .and. k_a .le. narray )
         zarray(k_a) = zsto(k_z)
         k_a = k_a + 1
         k_z = k_z + 1
      enddo
      do while ( k_a .le. narray )
         zarray(k_a) = -1.
         k_a = k_a + 1
      enddo
c
      return
      end
c
c******************************************************************************
c
      subroutine set_smooth( initsmooth, lowCOsmooth, interpCOsmooth )
c     ================================================================
c
      common/c_opal_ctrl_smooth/ init_smo, low_CO_smo, interp_CO_smo
      save /c_opal_ctrl_smooth/
c
      if ( initsmooth .ge. 0 ) init_smo = min( initsmooth , 2 )
c
      if ( lowCOsmooth .ge. 0 ) low_CO_smo = min( lowCOsmooth , 1 )
c
      if ( interpCOsmooth .ge. 0 )
     $     interp_CO_smo = min( interpCOsmooth , 1 )
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_smooth( initsmooth, lowCOsmooth, interpCOsmooth )
c     ================================================================
c
      common/c_opal_ctrl_smooth/ init_smo, low_CO_smo, interp_CO_smo
      save /c_opal_ctrl_smooth/
c
      initsmooth = init_smo
c
      lowCOsmooth = low_CO_smo
c
      interpCOsmooth = interp_CO_smo
c
      return
      end
c
c******************************************************************************
c
      subroutine set_logt_sw_ferg( fltsw_lo, fltsw_hi )
c     =================================================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /opac_ferg/ zlog_ferg(nzp1_ferg), xlog_ferg(nx_ferg),
     $     dzinvlog_ferg(nz_ferg), dzinv_ferg(nz_ferg),
     $     dxinvlog_ferg(nx_ferg), dxinv_ferg(nx_ferg),
     $     t6log_ferg(nt_ferg), rlog_ferg(nr_ferg),
     $     dt6inv_ferg(nt_ferg), drinv_ferg(nr_ferg),
     $     modt_ferg, modz0_ferg, ntuferg
      save /opac_ferg/
c
      common /c_tsw_ferg/ slt_max_ferg, sltswlo_ferg_def,
     $     sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $     sltswmid_ferg, dltsw2inv_ferg
      save /c_tsw_ferg/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c						! set T,R-values, if necessary
      if ( init_trvals .le. 0 ) call get_trvals
c
      slt_min = alt(1)
c
      if ( fltsw_lo .lt. -90.0 ) then
c
         if ( fltsw_hi .lt. -90.0 ) return
c
         if ( fltsw_hi .lt. -20.0 ) then
            sltswhi_ferg = sltswhi_ferg_def
         else
            sltswhi_ferg = max( slt_min + dt_alex ,
     $           min( slt_max_ferg , fltsw_hi - 6.0 ) )
         endif
         sltswlo_ferg = min( sltswlo_ferg , sltswhi_ferg - dt_alex )
c
      else if ( fltsw_hi .lt. -90.0 ) then
c
         if ( fltsw_hi .lt. -20.0 ) then
            sltswlo_ferg = sltswlo_ferg_def
         else
            sltswlo_ferg = min( slt_max_ferg - dt_alex ,
     $           max( slt_min , fltsw_lo - 6.0 ) )
         endif
         sltswhi_ferg = max( sltswhi_ferg , sltswlo_ferg + dt_alex )
c
      else if ( fltsw_lo .lt. -20.0 ) then
c
         if ( fltsw_hi .lt. -20.0 ) then
            sltswhi_ferg = sltswhi_ferg_def
            sltswlo_ferg = sltswlo_ferg_def
         else
            sltswhi_ferg = max( slt_min + dt_alex ,
     $           min( slt_max_ferg , fltsw_hi - 6.0 ) )
            sltswlo_ferg = max( slt_min , sltswhi_ferg
     $           - ( sltswhi_ferg_def - sltswlo_ferg_def ) )
         endif
c
      else if ( fltsw_hi .lt. -20.0 ) then
c
         sltswlo_ferg = min( slt_max_ferg - dt_alex ,
     $        max( slt_min , fltsw_lo - 6.0 ) )
         sltswhi_ferg = min( slt_max_ferg ,
     $        sltswlo_ferg + ( sltswhi_ferg_def - sltswlo_ferg_def ) )
c
      else if ( abs( fltsw_hi - fltsw_lo ) .lt. dt_alex ) then
c
         sltswlo_ferg = min( slt_max_ferg - dt_alex , max( slt_min ,
     $        ( fltsw_hi + fltsw_lo ) / 2.0 - 6.0 - 0.5 * dt_alex ) )
         sltswhi_ferg = sltswlo_ferg + dt_alex
c
      else
c
         sltswhi_ferg = max( fltsw_hi , fltsw_lo ) - 6.0
         sltswlo_ferg = min( fltsw_hi , fltsw_lo ) - 6.0
c
         if ( sltswhi_ferg .gt. slt_max_ferg ) then
            sltswhi_ferg = slt_max_ferg
            sltswlo_ferg = max( slt_min ,
     $           slt_max_ferg - abs( fltsw_hi - fltsw_lo ) )
         else if ( sltswlo_ferg .lt. slt_min ) then
            sltswlo_ferg = slt_min
            sltswhi_ferg = min( slt_max_ferg ,
     $           slt_min + abs( fltsw_hi - fltsw_lo ) )
         endif
c
      endif
c
c   ! if Ferguson opacity-inclusion is set, make sure low-T OPAL limit includes
c							! the switchover region
      if ( kdo_alex .gt. 0 .and. kavail_alex .gt. 1 )
     $     call set_logt6_limits( -99.0, -99.0, -99.0, -99.0 )
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_logt_sw_ferg( fltsw_lo, fltsw_hi )
c     =================================================
c
      common /c_tsw_ferg/ slt_max_ferg, sltswlo_ferg_def,
     $     sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $     sltswmid_ferg, dltsw2inv_ferg
      save /c_tsw_ferg/
c
      fltsw_lo = sltswlo_ferg + 6.0
      fltsw_hi = sltswhi_ferg + 6.0
c
      return
      end
c
c******************************************************************************
c
      subroutine set_logt_sw_alex( fltsw_lo, fltsw_hi )
c     =================================================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /c_ini_alex/ z_alex(nzp1_alex),x_alex(nx_alex),
     $     flt_alex(nt_alex),flro_alex(nrlo_alex:nr_alex)
      save /c_ini_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c						! set T,R-values, if necessary
      if ( init_trvals .le. 0 ) call get_trvals
c
      flt_min = alt(1) + 6.
c
      if ( fltsw_lo .lt. -90.0 ) then
c
         if ( fltsw_hi .lt. -90.0 ) return
c
         if ( fltsw_hi .lt. -20.0 ) then
            fltswhi_alex = fltswhi_alex_def
         else
            fltswhi_alex = max( flt_min + dt_alex ,
     $           min( flt_alex(nt_alex) , fltsw_hi ) )
         endif
         fltswlo_alex = min( fltswlo_alex , fltswhi_alex - dt_alex )
c
      else if ( fltsw_hi .lt. -90.0 ) then
c
         if ( fltsw_hi .lt. -20.0 ) then
            fltswlo_alex = fltswlo_alex_def
         else
            fltswlo_alex = min( flt_alex(nt_alex) - dt_alex ,
     $           max( flt_min , fltsw_lo ) )
         endif
         fltswhi_alex = max( fltswhi_alex , fltswlo_alex + dt_alex )
c
      else if ( fltsw_lo .lt. -20.0 ) then
c
         if ( fltsw_hi .lt. -20.0 ) then
            fltswhi_alex = fltswhi_alex_def
            fltswlo_alex = fltswlo_alex_def
         else
            fltswhi_alex = max( flt_min + dt_alex ,
     $           min( flt_alex(nt_alex) , fltsw_hi ) )
            fltswlo_alex = max( flt_min ,
     $           fltswhi_alex - 2. * dt_alex )
         endif
c
      else if ( fltsw_hi .lt. -20.0 ) then
c
         fltswlo_alex = min( flt_alex(nt_alex) - dt_alex ,
     $        max( flt_min , fltsw_lo ) )
         fltswhi_alex = min( flt_alex(nt_alex) ,
     $        fltswlo_alex + 2. * dt_alex )
c
      else if ( abs( fltsw_hi - fltsw_lo ) .lt. dt_alex ) then
c
         fltswlo_alex = min( flt_alex(nt_alex) - dt_alex ,
     $        max( flt_min ,
     $        ( fltsw_hi + fltsw_lo ) / 2.0 - 0.5 * dt_alex ) )
         fltswhi_alex = fltswlo_alex + dt_alex
c
      else
c
         fltswhi_alex = min( flt_alex(nt_alex) ,
     $        max( flt_min + dt_alex , fltsw_lo , fltsw_hi ) )
         fltswlo_alex = max( flt_min , min( flt_alex(nt_alex)
     $        - dt_alex , fltsw_lo , fltsw_hi ) )
c
      endif
c
      fltswmid_alex = ( fltswhi_alex + fltswlo_alex ) / 2.
      dltsw2inv_alex = 4. / ( fltswhi_alex - fltswlo_alex )**2
      sltswhi_alex = fltswhi_alex - 6.
      sltswlo_alex = fltswlo_alex - 6.
c
c	    ! if Alexander opacity-inclusion is set, make sure low-T, high-RHO
c				       ! OPAL limit includes switchover region
      if ( kdo_alex .gt. 0 .and. kavail_alex .eq. 1 ) then
         call set_logt6_limits( -99.0, -99.0, -99.0, -99.0 )
         call set_logr_limits( -99.0, -99.0, -99.0, -99.0 )
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine set_logrho_sw_alex( flrhosw_lo, flrhosw_hi )
c     =======================================================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /c_ini_alex/ z_alex(nzp1_alex),x_alex(nx_alex),
     $     flt_alex(nt_alex),flro_alex(nrlo_alex:nr_alex)
      save /c_ini_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      if ( flrhosw_lo .lt. -90.0 ) then
c
         if ( flrhosw_hi .lt. -90.0 ) return
c
         if ( flrhosw_hi .lt. -20.0 ) then
            flrhoswhi_alex = flrhoswhi_alex_def
         else
            flrhoswhi_alex = max( flro_alex(1) + dro_alex ,
     $           min( flro_alex(nr_alex) + dro_alex , flrhosw_hi ) )
         endif
         flrhoswlo_alex = min( flrhoswlo_alex ,
     $        flrhoswhi_alex - dro_alex )
c
      else if ( flrhosw_hi .lt. -90.0 ) then
c
         if ( flrhosw_lo .lt. -20.0 ) then
            flrhoswlo_alex = flrhoswlo_alex_def
         else
            flrhoswlo_alex = min( flro_alex(nr_alex) ,
     $           max( flro_alex(1) , flrhosw_lo ) )
         endif
         flrhoswhi_alex = max( flrhoswhi_alex ,
     $        flrhoswlo_alex + dro_alex )
c
      else if ( flrhosw_lo .lt. -20.0 ) then
c
         if ( flrhosw_hi .lt. -20.0 ) then
            flrhoswhi_alex = flrhoswhi_alex_def
            flrhoswlo_alex = flrhoswlo_alex_def
         else
            flrhoswhi_alex = max( flro_alex(1) + dro_alex ,
     $           min( flro_alex(nr_alex) + dro_alex , flrhosw_hi ) )
            flrhoswlo_alex = max( flro_alex(1) ,
     $           flrhoswhi_alex - 2. * dro_alex )
         endif
c
      else if ( flrhosw_hi .lt. -20.0 ) then
c
         flrhoswlo_alex = min( flro_alex(nr_alex) ,
     $        max( flro_alex(1) , flrhosw_lo ) )
         flrhoswhi_alex = min( flro_alex(nr_alex) + dro_alex ,
     $        flrhoswlo_alex + 2. * dro_alex )
c
      else
c
         flrhoswhi_alex = min( flro_alex(nr_alex) + dro_alex ,
     $        max( flro_alex(1) + dro_alex ,
     $        flrhosw_lo , flrhosw_hi ) )
         flrhoswlo_alex = max( flro_alex(1) ,
     $        min( flro_alex(nr_alex) , flrhosw_lo , flrhosw_hi ) )
c
         if ( flrhoswhi_alex - flrhoswlo_alex .lt. dro_alex ) then
            flrhoswhi_alex = min( flro_alex(nr_alex) + dro_alex ,
     $           flrhoswhi_alex + 0.5 * ( dro_alex
     $           - ( flrhoswhi_alex - flrhoswlo_alex ) ) )
            flrhoswlo_alex = max( flro_alex(1) ,
     $           flrhoswhi_alex - dro_alex )
            flrhoswhi_alex = flrhoswlo_alex + dro_alex
         endif 
c
      endif
c
      flrhoswmid_alex = ( flrhoswhi_alex + flrhoswlo_alex ) / 2.
      dlrhosw2inv_alex = 4. / ( flrhoswhi_alex - flrhoswlo_alex )**2
c
c				! make sure low-T, high-RHO OPAL limit includes
c							! switchover region
      if ( kdo_alex .gt. 0 .and.
     $     kavail_alex .eq. 1 .and. isw_rho_alex .gt. 0 )
     $     call set_logt_rhosw_alex( -99.0, -99.0 )
c
      return
      end
c
c******************************************************************************
c
      subroutine set_logt_rhosw_alex( fltsw_r_lo, fltsw_r_hi )
c     ========================================================
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /c_ini_alex/ z_alex(nzp1_alex),x_alex(nx_alex),
     $     flt_alex(nt_alex),flro_alex(nrlo_alex:nr_alex)
      save /c_ini_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c===						! set T,R-values, if necessary
      if ( init_trvals .le. 0 ) call get_trvals
c
      flt_min = alt(1) + 6.
c
      if ( fltsw_r_lo .lt. -90.0 ) then
c
         if ( fltsw_r_hi .lt. -90.0 ) then
c
            if ( fltswhi_r_alex .gt. fltswhi_alex ) then
               fltswlo_r_alex = max( flt_min - dt_alex ,
     $              fltswhi_alex
     $              - ( fltswhi_r_alex - fltswlo_r_alex ) )
               fltswhi_r_alex = fltswhi_alex
            endif
c
         else if ( fltsw_r_hi .lt. -20.0 ) then
c
            fltswhi_r_alex = min( fltswhi_alex - dt_alex ,
     $           fltswhi_r_alex_def )
            fltswlo_r_alex = min( fltswlo_r_alex ,
     $           fltswhi_r_alex - dt_alex )
c
         else
c
            fltswhi_r_alex = max( flt_min ,
     $           min( fltswhi_alex , fltsw_r_hi ) )
            fltswlo_r_alex = min( fltswlo_r_alex ,
     $           fltswhi_r_alex - dt_alex )
c
         endif
c
      else if ( fltsw_r_hi .lt. -90.0 ) then
c
         if ( fltsw_r_lo .lt. -20.0 ) then
            fltswlo_r_alex = fltswlo_r_alex_def
         else
            fltswlo_r_alex = min( fltswhi_alex - dt_alex ,
     $           max( flt_min - dt_alex , fltsw_r_lo ) )
         endif
         fltswhi_r_alex = max( fltswhi_r_alex ,
     $        fltswlo_r_alex + dt_alex )
c
      else if ( fltsw_r_lo .lt. -20.0 ) then
c
         if ( fltsw_r_hi .lt. -20.0 ) then
            fltswhi_r_alex = min( fltswhi_alex - dt_alex ,
     $           fltswhi_r_alex_def )
         else
            fltswhi_r_alex = min( fltswhi_alex ,
     $           max( flt_min , fltsw_r_hi ) )
         endif
         fltswlo_r_alex = max( flt_min ,
     $        fltswhi_r_alex - dt_alex ) - dt_alex
c
      else if ( fltsw_r_hi .lt. -20.0 ) then
c
         fltswlo_r_alex = max( flt_min - dt_alex ,
     $        min( fltswhi_alex - dt_alex , fltsw_r_lo , fltsw_r_hi ) )
         fltswhi_r_alex = min( fltswhi_alex ,
     $        fltswlo_r_alex + 2. * dt_alex )
c
      else
c
         fltswhi_r_alex = min( fltswhi_alex ,
     $        max( flt_min , fltsw_r_lo , fltsw_r_hi ) )
         fltswlo_r_alex = max( flt_min - dt_alex ,
     $        min( fltswhi_alex - dt_alex , fltsw_r_lo , fltsw_r_hi ) )
c
         if ( fltswhi_r_alex - fltswlo_r_alex .lt. dt_alex ) then
            fltswhi_r_alex = min( fltswhi_alex ,
     $           fltswhi_r_alex + 0.5 * ( dt_alex
     $           - ( fltswhi_r_alex - fltswlo_r_alex ) ) )
            fltswlo_r_alex = max( flt_min - dt_alex ,
     $           fltswhi_r_alex - dt_alex )
            fltswhi_r_alex = fltswlo_r_alex + dt_alex
         endif 
c
      endif
c					! make sure overlap region is O.K.
      if ( kdo_alex .gt. 0 .and.
     $     kavail_alex .eq. 1 .and. isw_rho_alex .gt. 0 ) then
         itmp = isw_rho_alex
c			   ! set_logt6_limits must NOT call set_logt_rhosw_alex
         isw_rho_alex = 0
         call set_logt6_limits( -99.0, -99.0, -99.0, -99.0 )
         call set_logr_limits( -99.0, -99.0, -99.0, -99.0 )
         isw_rho_alex = itmp
         if ( fltswlo_r_alex .lt. sltlo - 1. / dltlo_inv + 6. ) then
            fltswhi_r_alex = min( fltswhi_alex , sltlo - 1. / dltlo_inv
     $           + 6. + ( fltswhi_r_alex - fltswlo_r_alex ) )
            fltswlo_r_alex = sltlo - 1. / dltlo_inv + 6.
         endif
      endif
c
      fltswmid_r_alex = ( fltswhi_r_alex + fltswlo_r_alex ) / 2.
      dltsw2inv_r_alex = 4. / ( fltswhi_r_alex - fltswlo_r_alex )**2
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_logt_sw_alex( fltsw_lo, fltsw_hi )
c     =================================================
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      fltsw_lo = fltswlo_alex
      fltsw_hi = fltswhi_alex
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_logrho_sw_alex( flrhosw_lo, flrhosw_hi )
c     =======================================================
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      flrhosw_lo = flrhoswlo_alex
      flrhosw_hi = flrhoswhi_alex
c
      return
      end
c
c******************************************************************************
c
      subroutine ask_logt_rhosw_alex( fltsw_r_lo, fltsw_r_hi )
c     ========================================================
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      fltsw_r_lo = fltswlo_r_alex
      fltsw_r_hi = fltswhi_r_alex
c
      return
      end
c
c******************************************************************************
c
      subroutine readco(z,kallrd,khighz,iu_lo)
c     ========================================
c
c..... The purpose of this subroutine is to read the data tables; actually,
c      it just calls READEXCO to do the work, setting [O/Fe] = 0.0
c
c Z is the metallicity; opacities will be interpolated (quadratically) in Z if
c   necessary, with values of Z from 0.0 to 0.1 being allowed.
c kallrd is ignored (it is present only for backward compatibility).
c if khighz = 0 , then the file GN93hz is not used; else, GN93hz (or GS98hz,
c   for khighz < 0) may be used for the case C=O=0.0 to get improved opacities.
c iu_lo is the unit number from which the lowest Z-value files are read;
c   units iu_lo thru iu_lo+3 may be needed.
c
c===
      call readexco(z,kallrd,max(min(khighz,1),-1),iu_lo,0.0)
c
      return
      end
c
c******************************************************************************
c
      subroutine readexco(z,kallrd,khighz,iu_lo,ofebrack)
c     ===================================================
c
c..... The purpose of this subroutine is to read the data tables
c
c Z is the metallicity; opacities will be interpolated (quadratically) in Z if
c   necessary, with values of Z from 0.0 to 0.1 being allowed.
c kallrd is ignored (it is present only for backward compatibility).
c if khighz = 0 , then the file GN93hz is not used;
c           = 1 or more, then GN93hz is used if it will improve Z-interpolation
c           = 2 , then Alrd96a2 and GN93hz are used to interpolate in [O/Fe]
c           = 3 , then C95hz and GN93hz are used to interpolate in [O/Fe]
c           = 4 , then W95hz and GN93hz are used to interpolate in [O/Fe]
c           = 5 , then GN93hz and a user-specified file are used to interpolate
c                  in [O/Fe]
c           = -1 thru -5 : use GS98hz (and its variants with [O/Fe] > 0.0, for
c                  khighz < -1) to get alternate-mix opacities (note that the
c                  file GN93hz is still read in, for reference purposes)
c           = -11 thru -15, 11 thru 15: same as khighz = -1 thru -5 and 1 thru
c                  5, except that CNO-interpolation opacity files are read in
c           = -21 thru -25, 21 thru 25: same as khighz = -1 thru -5 and 1 thru
c                  5, except that a user-specified opacity interpolation file
c                  is read in
c           = -31 thru -35, 31 thru 35: same as khighz = -1 thru -5 and 1 thru
c                  5, except that BOTH the CNO- and user-specified opacity
c                  interpolation files are read in
c iu_lo is the unit number from which the lowest Z-value files are read;
c   units iu_lo thru iu_lo+3 may be needed.
c ofebrack is [O/Fe], logarithmic oxygen (or alpha-element) enhancement factor,
c   relative to the Sun: ofebrack = log10{ (O_mix/Fe_mix) / (O_sun/Fe_sun) } .
c   If khighz is 0 or 1, then ofebrack is ignored; otherwise, interpolate
c   logKappa linearly between mix 1 and mix khighz, the interpolation factors
c   being such as to yield the desired [O/Fe] from combining these mixes.
c   Note that GN93hz has [O/Fe] = 0.0, Alrd96a2 has [O/Fe] = 0.3, C95hz has
c   [O/Fe] = 0.4, and W95hz has [O/Fe] = 0.5, but they have different patterns
c   of enhancements for elements other than oxygen.  For khighz < 0, it is the
c   new file GS98hz that is defined to have [O/Fe] = 0.0, and its variants (by
c   default, GS98hz_OFe.3_Alrd96a2, GS98hz_OFe.4_C95, and GS98hz_OFe.5_W95) are
c   the ones used to interpolate in [O/Fe].
c
      parameter ( small_1m8=1.e-8, small_m1m6=-1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      parameter ( mx_hi=2*mx )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c===
      numz = 1
      if ( z .lt. small_m1m6 ) then
         zat = 0.02
      else if ( z .lt. small_1m8 ) then
         zat = 0.
      else
         zat = z
      endif
      kavail_cno = 1
      kavail_user = 1
c
      do i = -n_zmixes, n_totmix
         list_gn(i) = level_list
      enddo
      list_mult = level_list
c
      if ( level_list .gt. 0 ) then
         write(iu_list,1) zat, ofebrack
 1       format(' ***OPAL single Z =',f11.8,', [O/Fe] =',f11.7,
     $        ': read the following files:')
      endif
c
      call read_kz(1,zat,kallrd,khighz,iu_lo,ofebrack)
c
      zlow = zat - zacc(1)
      zmiddle = zat
      zhigh = zat + zacc(1)
      zlo_ex = zlow - zacc(1)
      zhi_ex = zhigh + zacc(1)
      dfsz(1) = 1.
c
      call finish_cno
c
      do i = -n_zmixes, n_totmix
         list_gn(i) = 0
      enddo
      list_mult = 0
c
      return
      end
c
c******************************************************************************
c
      subroutine readzexco(nzin,zlo,z,zhi,khighz,iu_lo,ofebrack)
c     ==========================================================
c
c  Similar to READEXCO, except that a range of  nzin  Z-values from  zlo  to
c  zhi  are used: see comments near the beginning of this file.
c
      parameter ( small_1m6=1.e-6, small_m1m6=-1.e-6, small_1m8=1.e-8 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      parameter ( mx_hi=2*mx )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
      parameter ( zdel=0.001, xdel=0.03, xdelmin=0.001 )
c
      parameter ( mz=8, mz_m1=mz-1, mz_m2=mz-2, mzhi=11, mzal=13,
     $     nzm=mzal+1, nadd_zavail=nzm-mz )
c
      common/zinter_opal_z/ zvalhi(mzhi),nofz(mzhi,5,mo),mnofz(mx),
     $     zval(mz),zalval(mzal),zavail(nzm),iadd_zavail(nadd_zavail)
      save /zinter_opal_z/
c
      common /alt_change_opal_z/ main_alt_change, iulow, khighz_in,
     $     ofebrack_in
      save /alt_change_opal_z/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c___
      dimension z_use(nzm)
c===
      kavail_cno = 1
      kavail_user = 1
c
      if ( level_err .gt. 0 .and. main_alt_change .ne. 0 .and.
     $     khighz .lt. -1 .and. mod( abs(khighz), 10 ) .gt. 1 .and.
     $     mod( abs(khighz), 10 ) .lt. 5 ) then
         write(6,5) khighz
 5       format(' WARNING: khighz=',i4,' used after',
     $        ' ''GS98hz'' file replaced: may yield bad [O/Fe].')
         if ( level_err .gt. 1 ) stop
     $        ' STOP -- READZEXCO: Error: non-GS98hz, khighz=-2,-3,-4 '
      endif
c
c  Get the number of Z-values and the "typical" value of Z
c
      if ( nzin .le. -9 ) then
c
         numz = min( nz , nzm )
c
      else
c
         if ( level_err .gt. 0 .and.
     $        ( nzin .le. 0 .or. nzin .gt. nz ) ) then
            write(6,10) nzin, nz
 10         format(' '/' STOP -- READZEXCO: bad Nzin =',i12,
     $           ' (should lie in range 1 to',i3,').')
            stop ' STOP -- READZEXCO: Error: bad Nzin value. '
         endif
c
         numz = max( 1 , min( nzin , nz , nzm ) )
c
      endif
c
      if ( z .ge. small_m1m6 ) then
         zat = z
      else if ( zlo .gt. small_m1m6 .and. zhi .ge. zlo ) then
         if ( nzin .eq. 2 ) then
            zat = ( max( zlo , 0.0 ) + max( zhi , 0.0 ) ) * 0.5
         else
            zat = exp( ( log( max( zlo , 0.0 ) + zdel )
     $           + log( max( zhi , 0.0 ) + zdel ) ) * 0.5 ) - zdel
         endif
         if ( zat .lt. small_1m8 ) zat = 0.
      else if ( max( zlo , zhi ) .gt. small_m1m6 ) then
         zat = max( zlo , zhi , 0.0 )
      else
         zat = 0.02
      endif
      if ( zat .lt. small_1m8 ) zat = 0.
c
c  If there is only one Z-value to store, call readexco instead, and return
c  (note that readexco will call read_kz and finish_cno):
c
      if ( numz .eq. 1 ) then
c
         call readexco(zat,1,khighz,iu_lo,ofebrack)
c
         if ( nzin .eq. 1 ) then
            if ( zlo .ge. small_m1m6 ) then
               zlow = min( zlow , zlo )
               zlo_ex = min( zlo_ex , max( 2. * zlow - zmiddle , 0. ) )
            endif
            zhigh = max( zhigh , zhi )
            zlo_ex = min( zlo_ex , zlow - zacc(1) )
            zhi_ex = max( zhi_ex , 2. * zhigh - zmiddle ,
     $           zhigh + zacc(1) )
         endif
c
         return
c
      endif
c
c  If there is more than one Z-value to store:
c					      ! make sure of available Z-values
      call get_zavail
c								! check Z > 0.1
      if ( max( zlo , zat , zhi ) .gt. zavail(nzm) + small_1m6 ) then
         write(6,20) nzin, zlo, zat, zhi, 'Z > 0.1 is not allowed!!!'
 20      format(' '/' READZEXCO Error (NumZ=',i2,
     $        '): bad Z values',3f13.8/'   ',a,a)
         stop ' STOP -- READZEXCO: Error: Z > 0.1 is not allowed!!! '
      endif
c					! check for Zlo, Z, Zhi out of order
      zlo_t = max( zlo , 0.0 )
      zhi_t = max( zhi , 0.0 )
      if ( zlo .lt. small_m1m6 ) zlo_t = zat
      if ( zhi .lt. small_m1m6 ) zhi_t = zat
      if ( level_err .gt. 0 .and. ( zat .gt. zhi_t + small_1m6 .or.
     $     zlo_t .gt. min( zat , zhi_t ) + small_1m6 ) ) then
         write(6,20) numz, zlo_t, zat, zhi_t,
     $        'Zlo, Z, Zhi should be in increasing order'
         stop ' STOP -- READZEXCO: Error: bad Z values. '
      endif
c
      zmiddle = min( zat , zavail(nzm) )
c
c  If there should be two Z-values, then handle this case and return:

      if ( numz .eq. 2 ) then
c							! error checking
         if ( level_err .gt. 0 .and.
     $        max( zlo , zhi ) .gt. small_m1m6 ) then
            if ( min( zlo , zhi ) .gt. small_m1m6 ) then
               if ( zhi_t - zlo_t .lt. 0.00001 ) then
                  write(6,20) numz, zlo_t, z, zhi_t,
     $                 'Zhi - Zlo < 1.E-5: Zlo and Zhi',
     $                 ' too close together for Nzin = 2'
                  stop ' STOP -- READZEXCO: Error: bad Z values. '
               else if ( zlo_t * 1.01 .gt. zhi_t + small_1m6 ) then
                  write(6,20) numz, zlo_t, z, zhi_t,
     $                 'Zhi / Zlo < 1.01: Zlo and Zhi',
     $                 ' too close together for Nzin = 2'
                  stop ' STOP -- READZEXCO: Error: bad Z values. '
               endif
            endif
            if ( zhi_t .lt. small_1m8 ) then
               rat_t = 0.
            else
               rat_t = zlo_t / zhi_t
            endif
            if ( rat_t .lt. 0.6 .and.
     $           zhi_t - zlo_t .gt. 0.0002 + small_1m8 ) then
               write(6,20) numz, zlo_t, z, zhi_t,
     $              'Zlo / Zhi < 0.6 (and Zhi-Zlo>0.0002):',
     $              'Zlo and Zhi too far apart for Nzin = 2'
               stop ' STOP -- READZEXCO: Error: bad Z values. '
            endif
         endif
c
c  (will be linear interpolation in log[Z+0.001]); default range is plus/minus
c  10 percent in Z (or 2.e-5), minimum range is at least 1 percent (or 1.e-5)
c
         if ( iabs(nzin) .gt. 2 .or.
     $        zlo .lt. small_m1m6 .or. zlo .gt. zat ) then
            if ( iabs(nzin) .gt. 2 .or. zhi .lt. zat ) then
               zlow = max( 0.0 , min( 0.9 * zmiddle ,
     $              zmiddle - 0.00001 , 0.8182 * zavail(nzm) ) )
               zhigh = min( zavail(nzm) , max( 1.1 * zmiddle ,
     $              zmiddle + 0.00001 , 1.1 * zlow / 0.9 ) )
            else
               zhigh = max( zmiddle , 0.00001 ,
     $              min( zhi , zavail(nzm) ) )
               zlow = max( 0.0 , min( zmiddle ,
     $              0.9 * zhigh / 1.1 , zhigh - 0.00002 ) )
            endif
         else if ( zhi .lt. zat ) then
            zlow = max( 0.0 ,
     $           min( zlo , zmiddle , zavail(nzm) - 0.01 ) )
            zhigh = min( zavail(nzm) , max( zmiddle ,
     $           1.1 * zlow / 0.9 , zlow + 0.00002 ) )
         else if ( zhi - zlo .lt. 0.00001 .or.
     $           zlo * 1.01 .gt. zhi ) then
            zlow = max( 0.0 , min( zlo , zmiddle - 0.000005 ,
     $           zmiddle / 1.005 , zavail(nzm) - 0.01 ) )
            zhigh = min( zavail(nzm) , max( zhi , zmiddle + 0.000005 ,
     $           zmiddle * 1.005 , 0.00001 ) )
         else
            zlow = max( 0.0 , min( zlo , zavail(nzm) - 0.01 ) )
            zhigh = min( zavail(nzm) , zhi )
         endif
c
         do i = -n_zmixes, n_totmix
            list_gn(i) = level_list
         enddo
         list_mult = level_list
c
         if ( level_list .gt. 0 ) then
            write(iu_list,1) numz, zlow, zhigh, ofebrack
 1          format(' ***OPAL nZin =',i3,': Z =',f11.8,' ...',f11.8,
     $           ', [O/Fe] =',f11.7,': read:')
         endif
c
         zat = zlow
         call read_kz(1,zat,1,khighz,iu_lo,ofebrack)
c
         zat = zhigh
         call read_kz(2,zat,1,khighz,iu_lo,ofebrack)
c
         zlo_ex = zlow - 0.5 * ( zhigh - zlow )
         zhi_ex = zhigh + 0.5 * ( zhigh - zlow )
         dfsz(2) = 1. / ( zvint(2) - zvint(1) )
         dfsz(1) = dfsz(2)
c
         call finish_cno
c
         do i = -n_zmixes, n_totmix
            list_gn(i) = 0
         enddo
         list_mult = 0
c
         return
c
c  Else if all available Z-values should be used, handle this case and return:
c
      else if ( numz .eq. nzm ) then
c
         zlow = 0.0
         zmiddle = zat
         zhigh = zavail(nzm)
         zlo_ex = small_m1m6
         zhi_ex = 2. * zavail(nzm) - zavail(nzm-1)
c
         do i = -n_zmixes, n_totmix
            list_gn(i) = level_list
         enddo
         list_mult = level_list
c
         if ( level_list .gt. 0 ) then
            write(iu_list,1) numz, zlow, zhigh, ofebrack
         endif
c
         do kz = 1, nzm
            zat = zavail(kz)
            call read_kz(kz,zat,1,khighz,iu_lo,ofebrack)
            if ( kz .gt. 1 )
     $           dfsz(kz) = 1. / ( zvint(kz) - zvint(kz-1) )
         enddo
c
         dfsz(1) = dfsz(2)
c
         call finish_cno
c
         do i = -n_zmixes, n_totmix
            list_gn(i) = 0
         enddo
         list_mult = 0
c
         return
c
      endif
c
c  If there should be at least three Z-values:
c						     ! check if Z-range too big
      if ( level_err .gt. 0 ) then
         j = mz
         do while ( j .gt. 2 .and. zhi_t .lt. zval(j-1) + small_1m6 )
            j = j - 1
         enddo
         i = 1
         do while ( i .lt. j - 1 .and.
     $        zlo_t .gt. zval(i+1) - small_1m6 )
            i = i + 1
         enddo
         if ( numz .lt. j - i ) then
            write(6,20) numz, zlo_t, z, zhi_t,
     $           'Zlo and Zhi too far apart for given Nzin value'
            stop ' STOP -- READZEXCO: Error: bad Z values. '
         endif
      endif
c						! check for input Z-range
      ilodel = 1
      if ( zlo .lt. small_m1m6 .or.
     $     ( zlo .gt. zhi .and. zhi .ge. small_m1m6 ) .or.
     $     ( zlo .gt. z .and. z .ge. small_m1m6 ) ) then
         if ( z .ge. small_m1m6 ) then
            zlow = z
         else
            zlow = zat
         endif
      else
         zlow = zlo
         ilodel = 0
      endif
      if ( zlow .lt. small_1m8 ) then
         zlow = 0.
         ilo1 = 1
         ilo2 = 1
      else
         zlow = min( zlow , zavail(nzm-2) )
         ilo2 = nzm - 2
         do while ( ilo2 .gt. 2 .and.
     $        zlow .lt. zavail(ilo2-1) + small_1m6 )
            ilo2 = ilo2 - 1
         enddo
         ilo1 = 1
         do while ( ilo1 .lt. ilo2 .and.
     $        zlow .gt. zavail(ilo1+1) - small_1m6 )
            ilo1 = ilo1 + 1
         enddo
      endif
c
      ihidel = 1
      if ( zhi .ge. max( z , zlo , small_m1m6 ) ) then
         zhigh = zhi
         ihidel = 0
      else if ( z .gt. small_m1m6 ) then
         zhigh = z
      else
         zhigh = zat
      endif
      zhigh = max( zavail(3) , min( zavail(nzm) , zhigh ) )
      if ( ilodel .eq. 0 .and. ilo1 .ge. nzm + 1 - numz ) then
         ihi2 = nzm
         ilo1 = nzm + 1 - numz
      else
         ihi2 = nzm
         do while ( ihi2 .gt. 3 .and.
     $        zhigh .lt. zavail(ihi2-1) + small_1m6 )
            ihi2 = ihi2 - 1
         enddo
         ihi1 = 3
         do while ( ihi1 .lt. ihi2 .and.
     $        zhigh .gt. zavail(min(ihi1+1,nzm)) - small_1m6 )
            ihi1 = ihi1 + 1
         enddo
         if ( ihidel .eq. 0 .and. ihi2 .le. numz ) then
            ilo1 = 1
            ihi2 = numz
         endif
      endif
c
c  If the number of Z-values to be used "numz"  is sufficent to encompass the
c  input Z-range, then handle this case and return:
c
      if ( ihi2 - ilo1 .lt. numz ) then
c					! get range -> numz, alternately adding
c							! low and high Z-values
         if ( numz .eq. 3 .and. ihi2 - ilo1 .eq. 1 .and.
     $        zavail(ihi2) - z .lt. z - zavail(ilo1) .and.
     $        ( ihidel .gt. 0 .or. ilodel .eq. 0 ) )
     $        ihi2 = min( ihi2 + 1 , nzm )
         do while ( ihi2 - ilo1 + 1 .lt. numz .and.
     $        ( ( ilo1 .gt. 1 .and. ilodel .gt. 0 ) .or.
     $        ( ihi2 .lt. nzm .and. ihidel .gt. 0 ) ) )
            ilo1 = max( ilo1 - ilodel , 1 )
            if ( ihi2 - ilo1 + 1 .lt. numz )
     $           ihi2 = min( ihi2 + ihidel , nzm )
         enddo
         do while ( ihi2 - ilo1 + 1 .lt. numz )
            ilo1 = max( ilo1 - 1 , 1 )
            if ( ihi2 - ilo1 + 1 .lt. numz )
     $           ihi2 = min( ihi2 + 1 , nzm )
         enddo
c
         zlow = zavail(ilo1)
         if ( numz .eq. 3 ) then
            zmiddle = zavail(ilo1+1)
         else if ( z .lt. small_m1m6 ) then
            zmiddle = ( zhi + zlo ) * 0.5
         endif
         zhigh = zavail(ihi2)
         if ( ilo1 .eq. 1 ) then
            zlo_ex = small_m1m6
         else
            zlo_ex = zavail(ilo1-1)
         endif
         zhi_ex = 2. * zavail(ihi2) - zavail(ihi2-1)
c
         do i = -n_zmixes, n_totmix
            list_gn(i) = level_list
         enddo
         list_mult = level_list
c
         if ( level_list .gt. 0 ) then
            write(iu_list,1) numz, zlow, zhigh, ofebrack
         endif
c
         do kz = 1, numz
            zat = zavail(ilo1+kz-1)
            call read_kz(kz,zat,1,khighz,iu_lo,ofebrack)
            if ( kz .gt. 1 )
     $           dfsz(kz) = 1. / ( zvint(kz) - zvint(kz-1) )
         enddo
c
         dfsz(1) = dfsz(2)
c
         call finish_cno
c
         do i = -n_zmixes, n_totmix
            list_gn(i) = 0
         enddo
         list_mult = 0
c
         return
c
      endif
c
c  The input Z-range does not fit between a set of numz values from zavail();
c  if the input value of numz was 3, then use the input Z-range even if it is
c  VERY wide (check only for unbalanced intervals in log[Z+0.001]), and return:
c
      if ( numz .eq. 3 .and. nzin .eq. 3 ) then
c
         zl_1 = log10( zlow + zdel )
         zl_2 = log10( zmiddle + zdel )
         zl_3 = log10( zhigh + zdel )
         if ( 2. * ( zl_3 - zl_2 ) .lt. zl_2 - zl_1 .or.
     $        2.6 * ( zl_2 - zl_1 ) .lt. zl_3 - zl_2 ) then
            zl_2 = ( zl_1 + zl_3 ) * 0.5
            zmiddle = 10.**zl_2 - zdel
         endif
c
         do i = -n_zmixes, n_totmix
            list_gn(i) = level_list
         enddo
         list_mult = level_list
c
         if ( level_list .gt. 0 ) then
            write(iu_list,1) numz, zlow, zhigh, ofebrack
         endif
c
         zat = zlow
         call read_kz(1,zat,1,khighz,iu_lo,ofebrack)
         zat = zmiddle
         call read_kz(2,zat,1,khighz,iu_lo,ofebrack)
         zat = zhigh
         call read_kz(3,zat,1,khighz,iu_lo,ofebrack)
c
         dfsz(3) = 1. / ( zvint(3) - zvint(2) )
         dfsz(2) = 1. / ( zvint(2) - zvint(1) )
         dfsz(1) = dfsz(2)
c
         zlo_ex = min( zlow - zacc(1) ,
     $        10.**( zl_1 - min( zl_2 - zl_1 ,
     $        log10( ( zavail(ilo1+1) + zdel )
     $        / ( zavail(ilo1) + zdel ) ) ) ) - zdel )
         if ( zlo_ex .lt. small_1m8 .and. zlo_ex .gt. 0. ) zlo_ex = 0.
         zhi_ex = min( 10.**( 2. * zl_3 - zl_2 ) - zdel ,
     $        zhigh + zavail(ihi2) - zavail(ihi2-1) )
c
         call finish_cno
c
         do i = -n_zmixes, n_totmix
            list_gn(i) = 0
         enddo
         list_mult = 0
c
         return
c
      endif
c
c  The input Z-range does not fit between a set of numz Z-values from zavail(),
c  and the input value of numz was greater than 3; find the corresponding
c  positions in the coarser array zval() of Z-values available from the
c  'Gz???.x??' files, and check whether this suffices:
c
      if ( zlow .lt. small_1m8 ) then
         jlo1 = 1
         jlo2 = 1
      else
         jlo2 = mz - 2
         do while ( jlo2 .gt. 2 .and.
     $        zlow .lt. zval(jlo2-1) + small_1m6 )
            jlo2 = jlo2 - 1
         enddo
         jlo1 = 1
         do while ( jlo1 .lt. jlo2 .and.
     $        zlow .gt. zval(jlo1+1) - small_1m6 )
            jlo1 = jlo1 + 1
         enddo
      endif
      jhi2 = mz
      do while ( jhi2 .gt. 3 .and.
     $     zhigh .lt. zval(jhi2-1) + small_1m6 )
         jhi2 = jhi2 - 1
      enddo
      jhi1 = 3
      do while ( jhi1 .lt. jhi2 .and.
     $     zhigh .gt. zval(min(jhi1+1,mz)) - small_1m6 )
         jhi1 = jhi1 + 1
      enddo
c
      nuse = jhi2 + 1 - jlo1
c
c  If this coarser spacing works, then use it, after shifting the endpoints
c  in to the closest encompassing Z-values from zavail(), and adding as many
c  Z-values from zavail() as is allowed by the value of numz:
c
      if ( nuse .le. numz ) then
c
         do i = jlo1, jhi2
            z_use(i+1-jlo1) = zval(i)
         enddo
         z_use(1) = zavail(ilo1)
         z_use(nuse) = zavail(ihi2)
         if ( ihi2 .eq. nzm .and. ilo1 .eq. nzm - 4 .and. numz .eq. 3 )
     $        z_use(2) = zavail(nzm-2)
c
         k_a = 0
         do while ( nuse .lt. numz .and. k_a .lt. nadd_zavail )
            k_a = k_a + 1
            zat = zavail( iadd_zavail(k_a) )
            if ( zat .gt. z_use(1) + small_1m6 .and.
     $           zat .lt. z_use(nuse) - small_1m6 ) then
               i = 2
               do while ( i .lt. nuse .and.
     $              z_use(i) + small_1m6 .lt. zat )
                  i = i + 1
               enddo
               do j = nuse, i, -1
                  z_use(j+1) = z_use(j)
               enddo
               z_use(i) = zat
               nuse = nuse + 1
            endif
         enddo
         if ( nuse .ne. numz ) stop
     $        ' STOP -- READEXCO Error: nuse < numz cannot happen. '
c
c  Else, if the coarser spacing still does not suffice, use an equal-interval
c  spacing in log(Z+0.001):
c
      else
c
c-dont;         z_use(1) = zavail(ilo1)
c-dont;         z_use(numz) = zavail(ihi2)
         z_use(1) = zlow
         z_use(numz) = zhigh
         z_1 = log( z_use(1) + zdel )
         z_2 = log( z_use(numz) + zdel )
         z_3 = ( z_2 - z_1 ) / ( numz - 1 )
         do i = 2, numz - 1
            z_use(i) = exp( ( i - 1 ) * z_3 + z_1 ) - zdel
         enddo
c
      endif
c
c  In either of the above cases, read in the corresponding opacities:
c
      do i = -n_zmixes, n_totmix
         list_gn(i) = level_list
      enddo
      list_mult = level_list
c
      if ( level_list .gt. 0 ) then
         write(iu_list,1) numz, z_use(1), z_use(numz), ofebrack
      endif
c
      do kz = 1, numz
         call read_kz(kz,z_use(kz),1,khighz,iu_lo,ofebrack)
         if ( kz .gt. 1 ) dfsz(kz) = 1. / ( zvint(kz) - zvint(kz-1) )
      enddo
c
      dfsz(1) = dfsz(2)
c
      zlow = z_use(1)
      zhigh = z_use(numz)
c
      zlo_ex = min( zlow - zacc(1) ,
     $     10.**( zvint(1) - log10( ( zavail(ilo1+1) + zdel )
     $     / ( zavail(ilo1) + zdel ) ) ) - zdel )
      zhi_ex = zhigh + zavail(ihi2) - zavail(ihi2-1)
c
      call finish_cno
c
      do i = -n_zmixes, n_totmix
         list_gn(i) = 0
      enddo
      list_mult = 0
c							! we are done: return
      return
      end
c
c******************************************************************************
c
      subroutine read_best_mol( iu, i_alex, cf_hz, ofebrack )
c     =======================================================
c
      character*(*) cf_hz
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_ofe_in_ferg/ ofein_ferg, i_ofe_ferg, i_ofe0_ferg
      save /c_ofe_in_ferg/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
      character*255 cf_tmp
c						     ! get valid Fortran unit
      if ( iu .gt. 0 .and. iu .le. 99 ) iualex = iu
      if ( iualex .eq. 5 .or. iualex .eq. 6 ) iualex = 7
c
      if ( i_alex .ge. 10 ) then
         iferg = i_alex / 10
         ialex_use = min( 4 , i_alex - 10 * iferg )
      else if ( i_alex .le. -10 ) then
         iferg = iabs( i_alex ) / 10
         ialex_use = max( -4 , i_alex + 10 * iferg )
      else
         iferg = 0
         ialex_use = min( 4 , max( -4 , i_alex ) )
      endif
c					! if should read in molecular opacities
      if ( ialex_use .ne. 0 ) then
c					! if Ferguson 2005 file not spcified
         if ( iferg .eq. 0 ) then
c					! try to match the OPAL file
c
            if ( cf_hz .eq. ' ' .or. cf_hz .eq. 'GN93hz' ) then
               iferg = -2
            else
               len = lnblnk( cf_hz )
               i = len
               do while ( i .gt. 1 .and. cf_hz(i:i) .ne. cb(1) .and.
     $              cf_hz(i:i) .ne. cb(2) )
                  i = i - 1
               enddo
               if ( cf_hz(i:i) .eq. cb(1) .or.
     $              cf_hz(i:i) .eq. cb(2) ) i = i + 1
c
               if ( i .eq. len ) then
                  if ( cf_hz(i:i) .eq. 'g' .or.
     $                 cf_hz(i:i+2) .eq. 'G' ) iferg = -2
               else if ( i .le. len - 2 ) then
                  if ( cf_hz(i:i+1) .eq. 'G.' .or.
     $                 cf_hz(i:i+1) .eq. 'g.' .or.
     $                 cf_hz(i:i+2) .eq. 'G93' .or.
     $                 cf_hz(i:i+2) .eq. 'g93' ) then
                     iferg = -2
                  else if ( cf_hz(i:i+2) .eq. 'G98' .or.
     $                 cf_hz(i:i+2) .eq. 'g98' ) then
                     iferg = -3
                  else if ( cf_hz(i:i+2) .eq. 'L03' .or.
     $                 cf_hz(i:i+2) .eq. 'l03' ) then
                     iferg = -4
                  else if ( cf_hz(i:i+2) .eq. 'S92' .or.
     $                 cf_hz(i:i+2) .eq. 's92' ) then
                     iferg = -6
                     if ( i .le. len - 4 ) then
                        if ( cf_hz(i+3:i+4) .eq. 'AE' .or.
     $                       cf_hz(i+3:i+4) .eq. 'ae' ) iferg = -7
                     endif
                  else if ( i .le. len - 3 ) then
                     if ( cf_hz(i:i+3) .eq. 'GN93' .or.
     $                    cf_hz(i:i+3) .eq. 'gn93' ) then
                        iferg = -2
                     else if ( cf_hz(i:i+3) .eq. 'GS98' .or.
     $                       cf_hz(i:i+3) .eq. 'gs98' ) then
                        iferg = -3
                     else if ( i .le. len - 4 ) then
                        if ( cf_hz(i:i+4) .eq. 'AGS04' .or.
     $                       cf_hz(i:i+4) .eq. 'ags04' .or.
     $                       cf_hz(i:i+4) .eq. 'AGS05' .or.
     $                       cf_hz(i:i+4) .eq. 'ags05' ) iferg = -5
                     endif
                  endif
               endif
            endif
c
            if ( iferg .eq. 0 .and.
     $           ltype_ferg(ntyp1_ferg) .le. 0 ) then
c
               j = i
               do while ( i .lt. len .and.
     $              ( ( cf_hz(j:j) .ge. 'A' .and.
     $              cf_hz(j:j) .le. 'Z' ) .or.
     $              ( cf_hz(j:j) .ge. 'a' .and.
     $              cf_hz(j:j) .le. 'z' ) ) )
                  j = j + 1
               enddo
               do while ( i .lt. len .and. cf_hz(j:j) .ge. '0'
     $              .and. cf_hz(j:j) .le. '9' )
                  j = j + 1
               enddo
               j = j - 1
c
               if ( j .gt. i .and. j - i + 1 + lsep_ferg .le. 80 ) then
                  iferg = - ntyp1_ferg
                  ltype_ferg(ntyp1_ferg) = j - i + 1 + lsep_ferg
                  ctype_ferg(ntyp1_ferg) = cf_hz(i:j) // csep_ferg
               endif
c
            endif
c
         endif
c						  ! find a Ferguson 2005 file
         call find_ferg( iferg, len_beg, cf_tmp )
c						  ! if none found:
         if ( len_beg .lt. 0 ) then
c					! read Alexander & Ferguson 1994 file
            call readalex( iu )
c					! else: read Ferguson et al 2005 files:
         else
c					! we will read the set that we found
            iferg_use = itype_ferg
            len_beg = -1
c			  ! if the Ferguson 2005 file was not specified, and a
c			  ! non-alpha-enhanced case was found, and [O/Fe] is
c								! non-zero:
            if ( iferg .le. 0 .and. ofebrack .ne. 0.0 .and.
     $           ( itype_ferg .le. 6 .or. itype_ferg .gt. 12 ) ) then
c
               imain = 3
               if ( ctype_ferg(imain)(1:3) .ne. 'g98' .or.
     $              ctype_ferg(imain)(4:3+lsep_ferg) .ne. csep_ferg )
     $              stop
     $              ' STOP -- bad ctype_ferg(3) value: cannot be. '
c
               ilo = 8
               if ( ctype_ferg(ilo)(1:5) .ne. 'gs98-' ) stop
     $              ' STOP -- bad ctype_ferg(8) value: cannot be. '
               if ( ctype_ferg(ilo)(6:5+lsep_ferg) .eq. csep_ferg .and.
     $              ctype_ferg(ilo)(6+lsep_ferg:6+lsep_ferg) .eq.
     $              '2' ) then
                  j = 6 + lsep_ferg
               else if ( ctype_ferg(ilo)(6:6) .eq. '.' .and.
     $                 ctype_ferg(ilo)(7:7) .eq. '2' ) then
                  j = 7
               else
                  stop ' STOP -- bad ctype_ferg(8) values: cannot be. '
               endif
               if ( ctype_ferg(ilo)(j+1:j+lsep_ferg) .ne. csep_ferg )
     $              stop
     $              ' STOP -- bad ctype_ferg(8) value: cannot be. '
c
               if ( ofebrack .ge. 0.0 ) then
                  ilo = ilo + 1
                  if ( ctype_ferg(ilo)(1:5) .ne. 'gs98+' .or.
     $                 ctype_ferg(ilo)(j+1:j+lsep_ferg) .ne. csep_ferg
     $                 .or. ctype_ferg(ilo)(j:j) .ne. '2' ) stop
     $                 ' STOP -- bad ctype_ferg(9) value: cannot be. '
               endif
c						      ! get closest [O/Fe] pair
               if ( ofebrack .le. 0.2 ) then
                  ihi = ilo
               else if ( ofebrack .le. 0.4 ) then
                  ihi = ilo + 1
                  if ( ctype_ferg(ihi)(1:5) .ne. 'gs98+' .or.
     $                 ctype_ferg(ihi)(j+1:j+lsep_ferg) .ne. csep_ferg
     $                 .or. ctype_ferg(ihi)(j:j) .ne. '4' ) stop
     $                 ' STOP -- bad ctype_ferg(10) value: cannot be. '
                  if ( abs( ofebrack - 0.4 ) .lt. small_1m6 ) ilo = ihi
               else if ( ofebrack .le. 0.6 ) then
                  ihi = ilo + 2
                  ilo = ilo + 1
                  if ( ctype_ferg(ilo)(1:5) .ne. 'gs98+' .or.
     $                 ctype_ferg(ilo)(j+1:j+lsep_ferg) .ne. csep_ferg
     $                 .or. ctype_ferg(ilo)(j:j) .ne. '4' ) stop
     $                 ' STOP -- bad ctype_ferg(10) value: cannot be. '
                  if ( ctype_ferg(ihi)(1:5) .ne. 'gs98+' .or.
     $                 ctype_ferg(ihi)(j+1:j+lsep_ferg) .ne. csep_ferg
     $                 .or. ctype_ferg(ihi)(j:j) .ne. '6' ) stop
     $                 ' STOP -- bad ctype_ferg(11) value: cannot be. '
                  if ( abs( ofebrack - 0.6 ) .lt. small_1m6 ) ilo = ihi
               else
                  ihi = ilo + 3
                  ilo = ilo + 2
                  if ( ctype_ferg(ilo)(1:5) .ne. 'gs98+' .or.
     $                 ctype_ferg(ilo)(j+1:j+lsep_ferg) .ne. csep_ferg
     $                 .or. ctype_ferg(ilo)(j:j) .ne. '6' ) stop
     $                 ' STOP -- bad ctype_ferg(11) value: cannot be. '
                  if ( ctype_ferg(ihi)(1:5) .ne. 'gs98+' .or.
     $                 ctype_ferg(ihi)(j+1:j+lsep_ferg) .ne. csep_ferg
     $                 .or. ctype_ferg(ihi)(j:j) .ne. '8' ) stop
     $                 ' STOP -- bad ctype_ferg(12) value: cannot be. '
                  if ( abs( ofebrack - 0.8 ) .lt. small_1m6 ) ilo = ihi
               endif
c
               if ( ilo .ge. ntyp1_ferg .or. ihi .ge. ntyp1_ferg .or.
     $              imain .ge. ntyp1_ferg ) stop
     $              ' STOP -- bad ctype_ferg() values: cannot be. '
c								    ! check g98
               call find_ferg( imain, len_beg, cf_tmp )
c								! check ilo
               if ( len_beg .ge. 0 )
     $              call find_ferg( ilo, len_beg, cf_tmp )
c								! check ihi
               if ( len_beg .ge. 0 .and. ihi .ne. ilo )
     $              call find_ferg( ihi, len_beg, cf_tmp )
c								! if all found
               if ( len_beg .ge. 0 ) then
c								! get [O/Fe]
                  read( ctype_ferg(ilo)(j:j), '(i1)' ) i
                  if ( ctype_ferg(ilo)(5:5) .eq. '-' ) then
                     ofe_lo = -0.1 * i
                  else
                     ofe_lo = 0.1 * i
                  endif
c								! of file(s)
                  if ( ilo .eq. ihi ) then
c							! and read them in
                     f_ofe = ofebrack / ofe_lo
c
                     call read_add_ferg( iu, 0.0, f_ofe, imain )
                     call read_add_ferg( iu, -1.0, f_ofe, ilo )
c
                  else
c
                     read( ctype_ferg(ihi)(j:j), '(i1)' ) i
                     if ( ctype_ferg(ihi)(5:5) .eq. '-' ) then
                        ofe_hi = -0.1 * i
                     else
                        ofe_hi = 0.1 * i
                     endif
c
                     f_ofe = ( ofebrack - ofe_lo )
     $                    / ( ofe_hi - ofe_lo )
c
                     call read_add_ferg( iu, 0.0, 1.0 - f_ofe, ilo )
                     call read_add_ferg( iu, 1.0, f_ofe, ihi )
                     call read_add_ferg( iu, 1.0, -1.0, imain )
c
                  endif
c							! else [if not found]:
               else if ( i_ofe0_ferg .gt. 0 .and.
     $                 i_ofe_ferg .gt. 0 ) then
c								! check s92
                  call find_ferg( i_ofe0_ferg, len_beg, cf_tmp )
c								! check s92ae
                  if ( len_beg .ge. 0 )
     $                 call find_ferg( i_ofe_ferg, len_beg, cf_tmp )
c								    ! if found:
                  if ( len_beg .ge. 0 ) then
c						   ! get [O/Fe] opacity shift
                     f_ofe = ofebrack / ofein_ferg
                     call read_add_ferg( iu, 0.0, f_ofe, i_ofe0_ferg )
                     call read_add_ferg( iu, -1.0, f_ofe, i_ofe_ferg )
c
                  endif
c
               endif
c
            endif
c					! if [O/Fe] opacity shift was obtained:
            if ( len_beg .ge. 0 ) then
c							 ! add Ferguson 2005
c							     !  opacities to it
               call read_add_ferg( iu, 1.0, 1.0, iferg_use )
c							           ! else: read
            else
c							     !  Ferguson 2005
               call read_add_ferg( iu, 0.0, 1.0, iferg_use )
c
            endif
c
         endif
c
      endif
c					! set molecular-opacity flag
      call set_alex_use( ialex_use )
c
      return
      end
c
c******************************************************************************
c
      subroutine readferg( iu )
c     =========================
c
c  Read in Ferguson et al. 2005 opacities, searching for an available case
c
      call read_add_ferg( iu, 0.0, 1.0, 0 )
c
      return
      end
c
c******************************************************************************
c
      subroutine addfile_ferg(iu,f_sto,f_read,cfileferg,i_full_path)
c     ==============================================================
c
      character*(*) cfileferg
c
      call set_alex_file( cfileferg, i_full_path )
c
      call read_add_ferg( iu, f_sto, f_read, 1 )
c
      return
      end
c
c******************************************************************************
c
      subroutine read_add_ferg( iu, f_sto, f_read, ktype_ferg )
c     =========================================================
c
c  Read in Ferguson et al. 2005 opacities, combining a factor  f_sto  times
c  the alread-stored logKappa values with  a factor  f_read  times the logKappa
c  values newly read in.
c
c  ktype_ferg = 0 : search for available case, in order 99,1,5,4,3,2,6,7,8, ...
c               1 : use case specified by CFILE_ALEX
c               2 : read GN93 case
c               3 : read GS98 case
c               4 : read L03 case
c               5 : read AGS04 case
c               6 : read S92 case
c               7 : read S92AE case
c               8 : read GS98-.2 case
c               9 : read GS98+.2 case
c              10 : read GS98+.4 case
c              11 : read GS98+.6 case
c              12 : read GS98+.8 case
c              13 to 99 : read user-specified case
c              -1 to -99 : try the case |ktype_ferg|, if not found use case 0
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /mat_alex_ferg/ flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg)
      save /mat_alex_ferg/
      dimension flk_alex(nrlo_alex:nr_alex,nt_alex,nzp1_alex,nx_alex)
      equivalence (flk_alex(nrlo_alex,1,1,1),flk_ferg(1,1,1,1))
c
      common /opac_ferg/ zlog_ferg(nzp1_ferg), xlog_ferg(nx_ferg),
     $     dzinvlog_ferg(nz_ferg), dzinv_ferg(nz_ferg),
     $     dxinvlog_ferg(nx_ferg), dxinv_ferg(nx_ferg),
     $     t6log_ferg(nt_ferg), rlog_ferg(nr_ferg),
     $     dt6inv_ferg(nt_ferg), drinv_ferg(nr_ferg),
     $     modt_ferg, modz0_ferg, ntuferg
      save /opac_ferg/
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_prev_ferg/ zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $     zlp2_ferg, xp2_ferg, i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
      save /c_prev_ferg/
c
      common /c_tsw_ferg/ slt_max_ferg, sltswlo_ferg_def,
     $     sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $     sltswmid_ferg, dltsw2inv_ferg
      save /c_tsw_ferg/
c
      character*255 cfile_alex
      common /c_filename_alex/ need_alex_dir, cfile_alex
      save /c_filename_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c
      character*255 cfile_use, clin
c
      dimension valin(0:nr_ferg)
c-debug[
c-debug;      common /c_debug_ferg/ i_debug_ferg
c-debug;      save /c_debug_ferg/
c-debug;c
c-debug;      data i_debug_ferg / 0 /
c-debug]
c
c-debug[
c-debug;      if ( i_debug_ferg .gt. 1 ) write(6,'(" ")')
c-debug;      if ( i_debug_ferg .gt. 0 ) write(6,
c-debug;     $     '(" ***** read_add_ferg(",a,i5,2(a,f11.7),a,i5,a,i3,a)')
c-debug;     $     ' iu', iu, ' f_sto', f_sto, ' f_read', f_read,
c-debug;     $     ' ktype_ferg', ktype_ferg,
c-debug;     $     " )  [kavail_alex=", kavail_alex, "]"
c-debug]
      if ( iu .gt. 0 .and. iu .le. 99 ) iualex = iu
      if ( iualex .eq. 5 .or. iualex .eq. 6 ) iualex = 7
c
      if ( f_read .eq. 0.0 ) return
c
      list_mult = level_list
c
      if ( max( abs(f_sto) , abs(f_read) ) .gt. 10.0 ) then
         write(6,10) kavail_alex, f_sto, f_read
 10      format(/' READ_ADD_FERG Error: (avail',i2,'): bad F_STO',
     $        1p,e14.6,' , F_READ',e14.6)
         stop ' STOP -- READ_ADD_FERG Error: bad F_STO and/or F_READ. '
      endif
c			! clear any cached Z,X-interpolated Ferguson opacities
      zlogp_ferg = -9.0
      xp_ferg = -9.0
      zlp1_ferg = -9.0
      xp1_ferg = -9.0
      zlp2_ferg = -9.0
      xp2_ferg = -9.0
      i1p_ferg = -1
      i4p_ferg = -9
      j1p_ferg = -1
      j4p_ferg = -9
c
      fusto = f_sto
c
      if ( kavail_alex .lt. 2 .or. f_sto .eq. 0.0 ) then
c
         fusto = 0.0
c
         ntuferg = nt_ferg
         modt_ferg = 0
         modz0_ferg = 0
c
         do ix = 1, nx_ferg
            do iz = 1, nz_ferg
               do it = 1, nt_ferg
                  do ir = 1, nr_ferg
                     flk_ferg(ir,it,iz,ix) = 0.0
                  enddo
               enddo
            enddo
         enddo
c
         if ( kavail_alex .lt. 2 ) then
c
            do i = 1, nz_ferg
               zlog_ferg(i) = log10( z_ferg(i) + zdel_ferg )
               if ( i .gt. 1 ) then
                  dzinv_ferg(i) = 1.0 / ( z_ferg(i) - z_ferg(i-1) )
                  dzinvlog_ferg(i) =
     $                 1.0 / ( zlog_ferg(i) - zlog_ferg(i-1) )
               endif
            enddo
            dzinv_ferg(1) = dzinv_ferg(2)
            dzinvlog_ferg(1) = dzinvlog_ferg(2)
            zlog_ferg(nzp1_ferg) = ( zlog_ferg(nz_ferg)
     $           - zlog_ferg(nz_ferg-1) ) + zlog_ferg(nz_ferg)
c
            do i = 1, nx_ferg
               xlog_ferg(i) = log10( x_ferg(i) + xdel_ferg )
               if ( i .gt. 1 ) then
                  dxinv_ferg(i) = 1.0 / ( x_ferg(i) - x_ferg(i-1) )
                  dxinvlog_ferg(i) =
     $                 1.0 / ( xlog_ferg(i) - xlog_ferg(i-1) )
               endif
            enddo
            dxinv_ferg(1) = dxinv_ferg(2)
            dxinvlog_ferg(1) = dxinvlog_ferg(2)
c
         endif
c
      endif
c
      kavail_alex = 0
c
      call init_ferg_indices
c
      itype_ferg = 0
c
      call find_ferg( ktype_ferg, len_beg, cfile_use )
c
      if ( itype_ferg .le. 0 ) then
         write(6,100)
     $        max( -ntyp1_ferg, min( ntyp1_ferg , ktype_ferg ) )
 100     format(/' READFERG Error: Furguson 2005 opacities not found',
     $        ' (looking for type', i4,').')
         stop ' STOP -- READFERG Error: Furguson 2005 file not found. '
      endif
c
      do ix = 1, nx_ferg
c
         x = x_ferg(ix)
c
c-debug[
c-debug;         if ( i_debug_ferg .gt. 8 ) write(6,'(" ")')
c-debug;         if ( i_debug_ferg .gt. 2 ) write(6,
c-debug;     $        '("  read(ix=",i3,") X=",f10.6," files ...")')
c-debug;     $        ix, x
c-debug]
         if ( ix .ne. nxm1_ferg ) then
            izhi = nz_ferg
         else
            izhi = n2_ferg
         endif
c
         do iz = 1, izhi
c
            len = len_beg
            j = ione_ferg(itype_ferg)
            z = z_ferg(iz)
c
            if ( ix .lt. nx_ferg ) then
               cfile_use(len+1:) = cx_ferg(ix)
               len = len + lx_ferg(ix)
               j = 0
            else if ( iz .gt. 1 ) then
               x = 1.0 - z
               cfile_use(len+1:) = cz_ferg(iz)
               len = len + lz_ferg(iz)
               do i = len_beg + 1, len
                  if ( i .eq. len ) then
                     read( cfile_use(i:i), '(i1)' ) j
                     if ( j .eq. 0 ) stop
     $                    ' STOP -- READFERG Error: bad last Z digit. '
                     write( cfile_use(i:i), '(i1)' ) 10 - j
                  else if ( cfile_use(i:i) .ne. '0' ) then
                     stop ' STOP -- READFERG Error: bad digit in Z. '
                  else
                     cfile_use(i:i) = '9'
                  endif
               enddo
               j = 0
            else if ( j .eq. 0 ) then
               cfile_use(len+1:) = cx_ferg(ix)
               len = len + lx_ferg(ix)
            else if ( j .gt. 0 ) then
               cfile_use(len+1:) = 'one'
               len = len + 3
            else
               cfile_use(len+1:) = 'one' // csep_ferg
               cfile_use(len+4+lsep_ferg:) = cext_ferg
               call open_chk_zip( -99999, cfile_use, igzip, '???' )
               if ( igzip .gt. -99999 ) then
                  len = len + 3
                  j = 1
               else
                  cfile_use(len+1:) = cx_ferg(ix)
                  len = len + lx_ferg(ix)
                  j = 0
               endif
            endif
c
            if ( j .eq. 0 ) then
               cfile_use(len+1:) = csep_ferg
               len = len + lsep_ferg
               cfile_use(len+1:) = cz_ferg(iz)
               len = len + lz_ferg(iz)
            endif
c
            cfile_use(len+1:) = csep_ferg
            len = len + lsep_ferg
c
            cfile_use(len+1:) = cext_ferg
            len = len + lext_ferg
c
c-debug[
c-debug;            if ( i_debug_ferg .gt. 8 ) write(6,'(" ")')
c-debug;            if ( i_debug_ferg .gt. 4 ) write(6,
c-debug;     $           '("    read(ix,iz=",2i3,") Z=",f10.6," file: ",a)')
c-debug;     $           ix, iz, z, cfile_use(:len)
c-debug]
            if ( list_mult .gt. 0 ) then
               if ( iu_list .eq. iualex ) then
                  write(6,4) iu_list
 4                format(/' ***OPAL WARNING: READ_ADD_FERG:',
     $                 ' bad LIST_IU =',i3,
     $                 ', reset to 6 (standard output)'/)
                  iu_list = 6
               endif
               if ( list_mult .eq. level_list ) then
                  if ( fusto .eq. 0.0 .and. f_read .eq. 1.0 ) then
                     if ( list_mult .eq. 1 ) then
                        write(iu_list,1) itype_ferg, cfile_use(:len),
     $                       '  ...'
 1                      format(' ***OPAL/MOL_FERG Type',i3,': ',a,a)
                     else
                        write(iu_list,1) itype_ferg, cfile_use(:len)
                     endif
                  else if ( list_mult .eq. 1 ) then
                     write(iu_list,2) fusto, itype_ferg, f_read,
     $                    cfile_use(:len), '  ...'
 2                   format(' ***OPAL/MOL_FERG_(STO *',f11.6,
     $                    ') + Type',i3,':',f11.6,' * ',a,a)
                  else
                     write(iu_list,2) fusto, itype_ferg, f_read,
     $                    cfile_use(:len)
                  endif
               else if ( list_mult .eq. 1 ) then
                  write(iu_list,3) cfile_use(:len), '  ...'
 3                format(' ***OPAL/MOL_FERG: ',a,a)
               else
                  write(iu_list,3) cfile_use(:len)
               endif
               list_mult = list_mult - 1
            endif
c
            call open_chk_zip( iualex, cfile_use, igzip,
     $           'READFERG Error: Ferguson 2005 opacity file not found:'
     $           )
c
            clin = ' '
            line = 0
c
            do while ( clin(1:5) .ne. 'log T' )
c
               line = line + 1
               read(iualex,'(a255)',err=900,end=950) clin
c
               len = lnblnk( clin )
               x_at = -9.999999
               z_at = -9.999999
               do i = 2, len - 9
                  if ( clin(i-1:i) .eq. 'X=' ) then
                     read( clin(i+1:i+9) , '(f9.6)' ) x_at
                  else if ( clin(i-1:i) .eq. 'Z=' ) then
                     read( clin(i+1:i+9) , '(f9.6)' ) z_at
                  endif
               enddo
c
               if ( ( x_at .gt. -9.9 .or. z_at .gt. -9.9 ) .and.
     $              ( abs( z_at - z ) .gt. small_1m6 .or.
     $              abs( x_at - x ) .gt. small_1m6 ) ) then
                  write(6,200) x, z, x_at, z_at, line,
     $                 clin(:len), cfile_use(:lnblnk(cfile_use))
 200              format(/' READFERG: input file should have X =',
     $                 f10.7,', Z =',f10.7/
     $                 '            but read bad value(s) X =',
     $                 f10.7,', Z =',f10.7,' from line',i5,':'/a/
     $                 '    of Ferguson et al. 2005',
     $                 ' molecular opacity file called:'/' ',a/)
                  stop ' STOP -- READFERG Error: bad Ferg-file X,Z. '
               endif
c
            enddo
c
            if ( igot_r_ferg .eq. 0 ) then
               read(clin,'(6x,35f7.3)',err=900)
     $              (rlog_ferg(i),i=1,nr_ferg)
               do i = 2, nr_ferg
                  if ( rlog_ferg(i) .le. rlog_ferg(i-1) ) stop
     $                 ' STOP -- READFERG Error: bad file R value. '
                  drinv_ferg(i) = 1.0
     $                 / ( rlog_ferg(i) - rlog_ferg(i-1) )
               enddo
               drinv_ferg(1) = drinv_ferg(2)
               igot_r_ferg = 1
            else
               read(clin,'(6x,35f7.3)',err=900) (valin(i),i=1,nr_ferg)
               do i = 1, nr_ferg
                  if ( abs( rlog_ferg(i) - valin(i) ) .gt.
     $                 small_1m6 ) stop
     $                 ' STOP -- READFERG Error: bad file logR value. '
               enddo
            endif
c
            it = 0
c
            do while ( it .lt. ntuferg )
c
               it = it + 1
               line = line + 1
c-debug[
c-debug;               if ( i_debug_ferg .gt. 8 ) write(6,
c-debug;     $              '("      read(ix,iz,it=",3i3,") line",i6," ...")')
c-debug;     $              ix, iz, it, line
c-debug]
c							       ! note EOF check
               read(iualex,'(a255)',err=900,end=250) clin
               read(clin,'(f5.3,1x,35f7.3)',err=900)
     $              (valin(i),i=0,nr_ferg)
c
               if ( igot_t_ferg .eq. 0 ) then
                  t6log_ferg(it) = valin(0) - 6.0
                  if ( modt_ferg .eq. 0 .and. valin(0) .lt. 3.4801 )
     $                 modt_ferg = it
                  if ( modz0_ferg .eq. 0 .and. valin(0) .lt. 3.899 )
     $                 modz0_ferg = it
                  if ( it .eq. 1 ) then
                     if ( abs( t6log_ferg(it) - slt_max_ferg ) .gt.
     $                    small_1m6 ) stop
     $                    ' STOP -- READFERG Error: bad file T value. '
                  else
                     if ( t6log_ferg(it) .ge. t6log_ferg(it-1) ) stop
     $                    ' STOP -- READFERG Error: bad file T value. '
                     dt6inv_ferg(it) = 1.0
     $                    / ( t6log_ferg(it) - t6log_ferg(it-1) )
                  endif
               else if ( abs( valin(0) - 6.0 - t6log_ferg(it) ) .gt.
     $                 small_1m6 ) then
                  stop ' STOP -- READFERG Error: bad file logT value. '
               endif
c
               do i = 1, nr_ferg
                  flk_ferg(i,it,iz,ix) = fusto * flk_ferg(i,it,iz,ix)
     $                 + f_read * valin(i)
               enddo
c			! end of T-input loop
            enddo
c			! skip EOF-code when no EOF found
            goto 270
c			! if file ends at logT of 3.0 or more, it is an error
c			! (note: one file of the L03 mix is missing logT < 2.8)
 250        continue
            if ( it .eq. 1 ) goto 950
            if ( t6log_ferg(it-1) .gt. -3.0 ) goto 950
            ntuferg = it - 1
c
 270        continue
c
            igot_t_ferg = 1
c
            call close_chk_zip( iualex, cfile_use, igzip )
c
c-debug[
c-debug;            if ( i_debug_ferg .gt. 8 ) write(6,
c-debug;     $           '("    DONE(ix,iz=",2i3,") Z=",f10.6," file: ",a)')
c-debug;     $           ix, iz, z, cfile_use(:lnblnk(cfile_use))
c-debug]
         enddo
c
      enddo
c
c-debug[
c-debug;      if ( i_debug_ferg .gt. 8 ) write(6,'(" ")')
c-debug;      if ( i_debug_ferg .gt. 1 ) write(6,
c-debug;     $     '(a,i3,":",f6.3," < logT <",f6.3)')
c-debug;     $     '  DONE reading Ferguson 2005 molecular opacities, type',
c-debug;     $     itype_ferg, t6log_ferg(ntuferg) + 6.0, t6log_ferg(1) + 6.0
c-debug]
      dt6inv_ferg(1) = dt6inv_ferg(2)
c
      kavail_alex = 2
      kdo_alex = kuse_alex
c			     ! if molecular opacity-inclusion is set, make sure
c			     ! low-T OPAL limit is low enough for switchover
      if ( kdo_alex .gt. 0 )
     $     call set_logt6_limits( -99.0, -99.0, -99.0, -99.0 )
c
c-debug[
c-debug;      if ( i_debug_ferg .gt. 1 ) write(6,
c-debug;     $     '("  read_add_ferg: RETURN.")')
c-debug]
      return
c
 900  write(6,910) line, clin(:max(1,lnblnk(clin))),
     $     cfile_use(:lnblnk(cfile_use))
 910  format(/' READFERG Error: while reading line',i6,':'/
     $     ' "',a,'"'/
     $     '                 of a Ferguson 2005 opacity file:'/
     $     ' ',a)
      stop ' STOP -- READFERG Error: reading Ferguson 2005 file. '
c
 950  write(6,960) line, cfile_use(:lnblnk(cfile_use))
 960  format(/' READFERG Error: premature EOF at line',i6,
     $     ' of a Ferguson 2005 opacity file:'/
     $     ' ',a)
      stop ' STOP -- READFERG Error: reading Ferguson 2005 file. '
      end
c
c******************************************************************************
c
      subroutine find_ferg( ktype_ferg, len_beg, cfile_use )
c     ======================================================
c
      character*255 cfile_use
c
c  ktype_ferg = 0 : search for available case, in order 99,1,5,4,3,2,6,7,8, ...
c               1 : use case specified by CFILE_ALEX
c               2 : read GN93 case
c               3 : read GS98 case
c               4 : read L03 case
c               5 : read AGS04 case
c               6 : read S92 case
c               7 : read S92AE case
c               8 : read GS98-.2 case
c               9 : read GS98+.2 case
c              10 : read GS98+.4 case
c              11 : read GS98+.6 case
c              12 : read GS98+.8 case
c              13 to 99 : read user-specified case
c              -1 to -99 : try the case |ktype_ferg|, if not found use case 0
c
c  Set itype_ferg to the case found, and return the filename  cfile_use
c  that was found and the length  len_beg  prior to the X-specification in
c  the filename.
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      character*255 cfile_alex
      common /c_filename_alex/ need_alex_dir, cfile_alex
      save /c_filename_alex/
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c							! which should we check
      if ( ktype_ferg .eq. 0 ) then
         ilo = 1
         ihi = ntyp1_ferg
      else
         ilo = 0
         if ( ktype_ferg .gt. 0 ) then
            ihi = 0
         else
            ihi = ntyp1_ferg
         endif
      endif
c			! try with and without copdir, cfile_alex
      do itry = 1, 4
c							   ! first to check
         itype_ferg = min( ntyp1_ferg , iabs(ktype_ferg) )
c
c				! for each type that should be checked:
         do ichk = ilo, ihi
c
            if ( ichk .gt. 0 ) itype_ferg = itype_def_ferg(ichk)
c
            len = 0
            cfile_use = ' '
c						! prepend opacity directory?
            if ( copdir .ne. ' ' .and.
     $           ( ( itry .le. 2 .and. need_alex_dir .gt. 0 ) .or.
     $           ( itry .gt. 2 .and. need_alex_dir .le. 0 ) ) ) then
               cfile_use = copdir
               len = lnblnk( cfile_use )
               if ( len .ge. 250 ) then
                  cfile_use = ' '
                  len = 0
               else if ( copdir(len:len) .ne. cb(1) .and.
     $                 copdir(len:len) .ne. cb(2) ) then
                  if ( cb(2) .eq. ']' ) then
                     i = len
                     do while ( i .gt. 0 .and.
     $                    cfile_use(max(1,i):max(1,i)) .ne. '[' )
                        i = i - 1
                     enddo
                  else
                     i = 0
                  endif
                  len = len + 1
                  if ( i .gt. 0 ) then
                     cfile_use(len:len) = cb(2)
                  else
                     cfile_use(len:len) = cb(1)
                  endif
               endif
            endif
c				     ! append Alex-directory (check VMS case):
            i = lnblnk( cfile_alex )
            if ( i .gt. 0 .and. len + i .lt. 250 .and.
     $           ( itry .eq. 1 .or. itry .eq. 3 ) ) then
               if ( len .gt. 0 .and. cb(2) .eq. ']' .and.
     $              cfile_alex(1:1) .eq. '[' .and.
     $              cfile_use(max(len,1):max(len,1)) .eq. ']' ) then
                  cfile_use(len:len) = '.'
                  cfile_use(len+1:) = cfile_alex(2:)
                  len = len + i - 1
               else
                  cfile_use(len+1:) = cfile_alex
                  len = len + i
               endif
            endif
c						! append beginning of filename
            if ( itype_ferg .gt. 1 ) then
c
               do while ( len .gt. 0 .and.
     $              cfile_use(max(len,1):max(len,1)) .ne. cb(1) .and.
     $              cfile_use(max(len,1):max(len,1)) .ne. cb(2) )
                  cfile_use(len:len) = ' '
                  len = len - 1
               enddo
c
               cfile_use(len+1:) = ctype_ferg(itype_ferg)
               len = len + max( 0 , ltype_ferg(itype_ferg) )
c
            endif
c			  ! append the rest of the Z=0.00001,X=0.99999 filename
            len_beg = len
c
            if ( cz_ferg(2) .ne. '00001' ) stop
     $           ' STOP -- READFERG Error: bad lowest Z value > 0. '
c
            do i = len + 1, len + lz_ferg(2)
               if ( i .le. 255 ) then
                  cfile_use(i:i) = '9'
               endif
            enddo
            len = len + lz_ferg(2)
            if ( len .lt. 255 ) cfile_use(len+1:) = csep_ferg
            len = len + lsep_ferg
            if ( len .lt. 255 ) cfile_use(len+1:) = cz_ferg(2)
            len = len + lz_ferg(2)
            if ( len .lt. 255 ) cfile_use(len+1:) = csep_ferg
            len = len + lsep_ferg
            if ( len .lt. 255 ) cfile_use(len+1:) = cext_ferg
            len = len + lext_ferg
c					! skip any filename that is too long
            if ( len .le. 255 ) then
c
               call open_chk_zip( -99999, cfile_use, igzip, '???' )
c								! found? return
               if ( igzip .gt. -99999 ) return
c							 ! check subdirectory?
               if ( csub_ferg(itype_ferg)(1:1) .ne. ' ' ) then
c
                  lsub_ferg = lnblnk( csub_ferg(itype_ferg) ) + 1
c								 ! for VMS only
                  if ( cb(2) .eq. ']' ) then
                     i = len_beg
                     do while ( i .gt. 0 .and.
     $                    cfile_use(max(i,1):max(i,1)) .ne. cb(1) .and.
     $                    cfile_use(max(i,1):max(i,1)) .ne. cb(2) )
                        i = i - 1
                     enddo
                     if ( i .eq. 0 .or.
     $                    cfile_use(max(i,1):max(i,1)) .eq. ':' )
     $                    lsub_ferg = lsub_ferg + 1
                  endif
c						    ! if filename not too long:
                  if ( len + lsub_ferg .le. 255 ) then
c
                     len_beg = len_beg + lsub_ferg
c							! shift filename
                     i = len
                     do while ( i .gt. 0 .and.
     $                    cfile_use(max(i,1):max(i,1)) .ne. cb(1) .and.
     $                    cfile_use(max(i,1):max(i,1)) .ne. cb(2) )
                        cfile_use(i+lsub_ferg:i+lsub_ferg) =
     $                       cfile_use(i:i)
                        i = i - 1
                     enddo
c						! for VMS only: need '[' or '.'
                     if ( cb(2) .eq. ']' ) then
                        if ( i .eq. 0 .or.
     $                       cfile_use(max(i,1):max(i,1)) .eq.
     $                       ':' ) then
                           i = i + 1
                           lsub_ferg = lsub_ferg - 1
                           cfile_use(i:i) = '['
                        else
                           cfile_use(i:i) = '.'
                        endif
                     endif
c						! insert subdirectory name
c
                     cfile_use(i+1:i+lsub_ferg) = csub_ferg(itype_ferg)
                     cfile_use(i+lsub_ferg:i+lsub_ferg) = cb(2)
c
                     call open_chk_zip( -99999, cfile_use,
     $                                  igzip, '???' )
c								       ! found?
                     if ( igzip .gt. -99999 ) return
c
                  endif
c
               endif
c
            endif
c
         enddo
c
      enddo
c			! if no file found: return with values to so indicate
      len_beg = -1
      itype_ferg = 0
c
      return
      end
c
c******************************************************************************
c
      subroutine init_ferg_indices
c     ============================
c
c  Initialize Ferguson array-position indices to valid values; clear cache.
c
      common /c_ferg_indices/ mf, mg, mh, mf2, kf, kg, kh, kf2,
     $     i1, i2, i3, i4, j1, j2, j3, j4
      save /c_ferg_indices/
c
      common /c_prev_ferg/ zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $     zlp2_ferg, xp2_ferg, i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
      save /c_prev_ferg/
c
      mf = 1
      mg = 2
      mh = 3
      mf2 = 4
c
      kf = 1
      kg = 2
      kh = 3
      kf2 = 4
c
      i1 = 1
      i2 = 2
      i3 = 3
      i4 = 4
c
      j1 = 1
      j2 = 2
      j3 = 3
      j4 = 4
c
      zlogp_ferg = -9.0
      xp_ferg = -9.0
      zlp1_ferg = -9.0
      xp1_ferg = -9.0
      zlp2_ferg = -9.0
      xp2_ferg = -9.0
c
      i1p_ferg = -1
      i4p_ferg = -9
      j1p_ferg = -1
      j4p_ferg = -9
c
      return
      end
c
c******************************************************************************
c
      subroutine readalex( iu )
c     =========================
c
c  Read in the (outdated) Alexander & Ferguson 1994 molecular opacities.
c
c  If 0 < iu < 100, use Fortran unit iu; otherwise, use default unit of 23.
c
c  !**************************************************************************!
c  ! Alexander 1994 molecular/grain opacity tables.                           !
c  !          (Ref: D.R. Alexander & J.W. Ferguson 1994, ApJ,437,879-891)     !
c  ! (*Note: These tables were provided by Dr Chris Tout with the H exhausted !
c  !         tables (i.e. X=0) having to be extracted from full tables with   !
c  !         smoothing taken out. See program alex_extract.f90 for details.)  !
c  !**************************************************************************!
c  Note: except for Z=1.0, the X=0 tables are identical to the X=0.0001 tables.
c
c===================================================== ALEXANDER's README FILE:
c  Each table begins with a header record which describes the composition.
c  After the header record, the data format is as follows.  Opacities for
c  a given temperature appear on three consequtive lines.  The format of
c  these lines is:  (i2,i3,f6.3,f5.1,8f8.3/10f8.3/7f8.3)
c
c  index number for this temperature                      (I2)
c  number of densities for this temperature               (I3)
c  log T                                                  (F6.3)
c  log rho for first density                              (F5.1)
c    (each successive point increments the density by 0.250 dex)
c  values of the Rosseland opacity expressed as logs      (25F8.3)
c
c  When you publish papers which utilize these opacities, please acknowledge
c  my contribution and the support of grants NSF AST-9217946 and STScI GO-4685.
c==============================================================================
c
c  ---In the original file alexopac.tab :
c  The Z=0.002 opacities were bad for logT > 3.2,
c  the Z=0.001 opacities were bad for logT < 3.7,
c  and for X=0.1 the Z=0.0001 opacities were bad for logT > 3.6.
c
c  ---In the corrected file Alexopac :
c    The three cases with bad opacities have been fixed.
c    A set of {Z=0.0,X=0.7} opacities have been obtained using Fig. 1 of
c  Alexander & Ferguson 1994, and the OPAL opacities at logT = 3.75 or higher.
c    For {Z=0.0,X=0.0} a rough approximation of the opacities has been obtained
c  by using the OPAL opacities at high-T, and extrapolating logK downwards in
c  logT, by fitting a least-squares quadratic to the average OPAL opacity at
c  each temperature in the range logT[3.75,3.90] and using this quadratic
c    logK = 5.78723 * (logT-3.75)^2 + 10.78878 * (logT-3.75) + const
c  at each density to extrapolate down in temperature, with the constant set to
c  yield the lowest available OPAL opacity at that density.
c    For other X-values at Z=0.0 these two opacity sets were interpolated in X.
c    For the higher metallicity cases Z=0.05 and 0.1, the Alexander opacities
c  were extrapolated in Z using the Z=0.02 and 0.03 cases, taking the average
c  of the result of extrapolating K in Z and of logK in logZ.
c    Note that the X=0.0001 opacities should be treated as if they had X=0.
c
c  The Z=1.0 opacity set has been moved to the beginning of the file, and the
c  opacities with Z=0.0, 0.05, and 0.1 inserted in the appropriate places.
c
c  Note that Alexander opacities are not given for X > 0.8, so there may be
c  some inaccuracy in extrapolating towards X = 1 - Z, but comparison with
c  OPAL opacities suggests that any such X-extrapolation error is at worst
c  comparable to the difference between the OPAL and Alexander opacities
c  (at least in the temperature range where OPAL and Alexander tables overlap).
c
c  ANDERS & GREVESSE 89 MIX  in CORRECTED file Alexopac :
c  ------------------------------------------------------
c  logRHO = -12.0 (0.25) -6.0 : 25 values,
c    logT = 4.10 (-0.05) 3.00 : 23 values, in all cases.
c
c   Z=1.0     1.X=0.0          --         --         --         --         --
c   Z=0.0     2.X=0.0     13.X=0.03  24.X=0.10  35.X=0.35  46.X=0.70  57.X=0.80
c   Z=0.0001  3.X=0.0001  14.X=0.03  25.X=0.10  36.X=0.35  47.X=0.70  58.X=0.80
c   Z=0.0003  4.X=0.0001  15.X=0.03  26.X=0.10  37.X=0.35  48.X=0.70  59.X=0.80
c   Z=0.001   5.X=0.0001  16.X=0.03  27.X=0.10  38.X=0.35  49.X=0.70  60.X=0.80
c   Z=0.002   6.X=0.0001  17.X=0.03  28.X=0.10  39.X=0.35  50.X=0.70  61.X=0.80
c   Z=0.004   7.X=0.0001  18.X=0.03  29.X=0.10  40.X=0.35  51.X=0.70  62.X=0.80
c   Z=0.01    8.X=0.0001  19.X=0.03  30.X=0.10  41.X=0.35  52.X=0.70  63.X=0.80
c   Z=0.02    9.X=0.0001  20.X=0.03  31.X=0.10  42.X=0.35  53.X=0.70  64.X=0.80
c   Z=0.03   10.X=0.0001  21.X=0.03  32.X=0.10  43.X=0.35  54.X=0.70  65.X=0.80
c   Z=0.05   11.X=0.0001  22.X=0.03  33.X=0.10  44.X=0.35  55.X=0.70  66.X=0.80
c   Z=0.1    12.X=0.0001  23.X=0.03  34.X=0.10  45.X=0.35  56.X=0.70  67.X=0.80
c
      parameter ( small_1m6=1.e-6, small_1m5=1.e-5 )
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /mat_alex_ferg/ flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg)
      save /mat_alex_ferg/
      dimension flk_alex(nrlo_alex:nr_alex,nt_alex,nzp1_alex,nx_alex)
      equivalence (flk_alex(nrlo_alex,1,1,1),flk_ferg(1,1,1,1))
c
      common /opac_alex/ zlog_alex(nzp1_alex),xlog_alex(nx_alex),
     $     dzinvlog_alex(nzp1_alex),dxinvlog_alex(nx_alex)
      save /opac_alex/
c
      common /c_ini_alex/ z_alex(nzp1_alex),x_alex(nx_alex),
     $     flt_alex(nt_alex),flro_alex(nrlo_alex:nr_alex)
      save /c_ini_alex/
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      character*255 cfile_alex
      common /c_filename_alex/ need_alex_dir, cfile_alex
      save /c_filename_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c___
      character*255 cfile_use
      dimension flk_min(nt_alex), dflkt_max(nt_alex)
c===
      if ( iu .gt. 0 .and. iu .le. 99 ) iualex = iu
      if ( iualex .eq. 5 .or. iualex .eq. 6 ) iualex = 7
c
c					! if were already obtained, return
      if ( kavail_alex .eq. 1 ) return
c					! get log Z and X values
      do i = 1,nzp1_alex
         zlog_alex(i) = log10(z_alex(i)+zdel_alex)
         if ( i .gt. 1 )
     $        dzinvlog_alex(i) = 1./(zlog_alex(i)-zlog_alex(i-1))
      enddo
      dzinvlog_alex(1) = dzinvlog_alex(2)
c
      do i = 1,nx_alex
         xlog_alex(i) = log10(x_alex(i)+xdel_alex)
         if ( i .gt. 1 )
     $        dxinvlog_alex(i) = 1./(xlog_alex(i)-xlog_alex(i-1))
      enddo
      dxinvlog_alex(1) = dxinvlog_alex(2)
c					  ! get Alexander opacity file name:
      if ( need_alex_dir .gt. 0 ) then
         kx = lnblnk(copdir)
      else
         kx = 0
      endif
      kt = lnblnk(cfile_alex)
      kd = 0
c							   ! blank? Use default
      if ( kt .le. 0 .or. cfile_alex(1:1) .eq. ' ' ) then
         kd = ltype_ferg(1)
         kt = 0
      else
         if ( cfile_alex(kt:kt) .eq. cb(1) .or.
     $        cfile_alex(kt:kt) .eq. cb(2) ) kd = ltype_ferg(1)
      endif
c					 ! directory + file name too long?
      if ( kx + kt + kd .gt. 255 ) then
         if ( kd .gt. 0 ) then
            if ( kx .gt. 0 ) then
               if ( kt .gt. 0 ) then
                  write(6,10) copdir(:kx),
     $                 cfile_alex(:kt), ctype_ferg(1)(:kd)
               else
                  write(6,10) copdir(:kx), ctype_ferg(1)(:kd)
               endif
            else if ( kt .gt. 0 ) then
               write(6,10) cfile_alex(:kt), ctype_ferg(1)(:kd)
            else
               write(6,10) ctype_ferg(1)(:kd)
            endif
         else if ( kx .gt. 0 ) then
            write(6,10) copdir(:kx), cfile_alex(:kt)
         else
            write(6,10) cfile_alex(:kt)
         endif
 10      format(' READALEX Error: directory + file name > 255 chars:'/
     $        ' ',a/' ',a,a)
         stop ' STOP -- READALEX Error: dir+file name > 255 chars. '
      endif
c				! combine directory and file name
      if ( kx .gt. 0 ) then
c					    ! check for error in directory name
         if ( copdir(kx:kx) .ne. cb(1) .and.
     $        copdir(kx:kx) .ne. cb(2) ) then
            write(6,15) cb(1), cb(2), copdir(:kx)
 15         format(' READALEX Error: directory name does not end in "',
     $           a1,'" or "',a1,'":'/' ',a)
            stop ' STOP -- READALEX Error: directory name bad last char'
         endif
c
         if ( kd .le. 0 ) then
            cfile_use = copdir(:kx) // cfile_alex
         else if ( kt .le. 0 ) then
            cfile_use = copdir(:kx) // ctype_ferg(1)
         else
            cfile_use = copdir(:kx) // cfile_alex(:kt) // ctype_ferg(1)
         endif
c
      else if ( kd .le. 0 ) then
c
         cfile_use = cfile_alex
c
      else if ( kt .le. 0 ) then
c
         cfile_use = ctype_ferg(1)
c
      else
c
         cfile_use = cfile_alex(:kt) // ctype_ferg(1)
c
      endif
c
      cfile_opal_used(2) = cfile_use
c
      if ( level_list .gt. 0 ) then
         if ( iu_list .eq. iualex ) then
            write(6,4) iu_list
 4          format(/' ***OPAL WARNING: READALEX:',
     $           ' bad LIST_IU =',i3,
     $           ', reset to 6 (standard output)'/)
            iu_list = 6
         endif
         write(iu_list,1) cfile_use(:lnblnk(cfile_use))
 1       format(' ***OPAL/MOL_ALEX[OLD]: ',a)
      endif
c						  ! open Alexander opacity file
      call open_chk_zip( iualex, cfile_use, i_gzip,
     $     'READALEX Error: Alexander 1994 opacity file not found:' )
c
c  Read Alexander opacities for (Z = 1.0, X = 0.0) and for
c Z = { 0.0, 0.0001, 0.0003, 0.001, 0.002, 0.004, 0.01, 0.02, 0.03, 0.05, 0.1 }
c  at X = { 0.0, 0.03, 0.1, 0.35, 0.7, 0.8 } ,
c in all cases for the temperature-density range
c  logT = 3.00 (0.05) 4.10 , logRHO = -12.00 (0.25) -6.00
c							   ! read Z=1,X=0 case:
      read(iualex,100) x,z
 100  format(29x,f6.4,7x,f6.4)
c            0----+----1----+----2----+----       0----+--
c100  format('ANDERS & GREVESSE 89 MIX   X=',f6.4,'     Z=',f6.4)
      if ( abs(x) .gt. small_1m6 .or. abs(z-1.) .gt. small_1m6 ) stop
     $     ' STOP -- READALEX: bad initial X not 0 or Z not 1. '
      do kt = nt_alex,1,-1
         read(iualex,115) ktat,nrat,fltat,flroloat,
     $        (flk_alex(kr,kt,nzp1_alex,1),kr=1,nr_alex)
 115     format(i2,i3,f6.3,f5.1,8f8.3/10f8.3/7f8.3)
         if ( ktat+kt-1 .ne. nt_alex .or. nrat .ne. nr_alex .or.
     $        abs(fltat-flt_alex(kt)) .gt. small_1m5 .or.
     $        abs(flroloat-flro_alex(1)) .gt. small_1m5 ) stop
     $        ' STOP -- READALEX: bad opacity input line for X=0,Z=1. '
      enddo
c				! read all other (X,Z) cases:
      do kx = 1,nx_alex
         do kz = 1,nz_alex
            read(iualex,100) x,z
            if ( ( abs(x_alex(kx)-x) .gt. small_1m6 .and.
     $           ( x_alex(kx) .ne. 0. .or.
     $           abs(x-0.0001) .gt. small_1m6 ) ) .or.
     $           abs(z_alex(kz)-z) .gt. small_1m6 ) stop
     $           ' STOP -- SETALEX: bad X or Z value. '
            do kt = nt_alex,1,-1
               read(iualex,115) ktat,nrat,fltat,flroloat,
     $              (flk_alex(kr,kt,kz,kx),kr=1,nr_alex)
               if ( ktat+kt-1 .ne. nt_alex .or. nrat .ne. nr_alex .or.
     $              abs(fltat-flt_alex(kt)) .gt. small_1m5 .or.
     $              abs(flroloat-flro_alex(1)) .gt. small_1m5 ) stop
     $              ' STOP -- READALEX: bad opacity input line. '
            enddo
         enddo
      enddo
c							! close file
      call close_chk_zip( iualex, cfile_use, i_gzip )
c
c  Extrapolate Alexander opacities down in density as far as logRHO = -14 (note
c  that the file contains opacities only for densities down to logRHO = -12).
c  The extrapolation algorithm below should yield reasonable results, except
c  at very low temparatures (logT < 3.15).
c
      do kz = 1, nzp1_alex
c
         do kx = 1, nx_alex - ( kz / nzp1_alex ) * nxm1_alex
c
            kt_min = 1
c						! at each T for logRHO >= -12:
            do kt = 1, nt_alex
c
               kt1 = min( kt + 1 , nt_alex )
c							! find minimum logKappa
               flk_min(kt) = flk_alex(1,kt,kz,kx)
c							! and maximum increase
c						! in logKappa with decreasing T
               kr_hi = 2
               dflkt_max(kt) = max( 0.25 , flk_alex(1,kt,kz,kx)
     $              - flk_alex(1,kt1,kz,kx) )
               do kr = 2, nr_alex
                  flk_min(kt) = min( flk_min(kt) ,
     $                 flk_alex(kr,kt,kz,kx) )
                  if ( kr .eq. kr_hi ) then
                     if ( flk_alex(kr,kt,kz,kx) .lt.
     $                    flk_alex(kr,kt1,kz,kx) ) then
                        kr_hi = kr + 1
                     else if ( flk_alex(kr,kt,kz,kx) -
     $                       flk_alex(1,kt,kz,kx) .lt.
     $                       max( dflkt_max(kt) ,
     $                       min( 3. * ( flk_alex(kr-1,kt,kz,kx) -
     $                       flk_alex(1,kt,kz,kx) ) ,
     $                       2. * ( flk_alex(kr,kt,kz,kx)
     $                       - flk_alex(kr,kt1,kz,kx) ) ) ) ) then
                        dflkt_max(kt) = max( dflkt_max(kt) ,
     $                       flk_alex(kr,kt,kz,kx)
     $                       - flk_alex(kr,kt1,kz,kx) )
                        kr_hi = kr + 1
                     endif
                  endif
               enddo
c
               if ( flk_min(kt) .lt. flk_min(kt_min) ) kt_min = kt
c
            enddo
c				   ! max allowed K-increase as T decreases
            do kt = 1, nt_alex - 2
               dflkt_max(kt) = max( 0.5 , dflkt_max(kt)  ,
     $              dflkt_max(kt+1)  , dflkt_max(kt+2) )
            enddo
c		  ! estimate reasonable minimum allowed logKappa for logRHO<-12
c
            if ( kz .eq. 1 ) then
c					! Z = 0.0 : no minimum at low T
               kt_min = nt_alex / 2
c
               do kt = kt_min, 1, -1
                  flk_min(kt) = flk_min(kt) + 10. * min( 0.0 ,
     $                  flk_alex(1,kt,1,kx) - flk_alex(2,kt,1,kx) )
               enddo
c
            else
c					! Z > 0.0 : get minima at low T
               del = min( 0.0 ,
     $              flk_min(kt_min) - flk_min(min(kt_min+1,nt_alex)) )
               if ( kt_min .lt. nt_alex - 5 ) then
                  del = min( del ,
     $                 0.8 * ( flk_min(kt_min+1) - flk_min(kt_min+2) ) )
               endif
c
               do kt = kt_min, 1, -1
                  flk_min(kt) = min( flk_min(kt) , flk_min(kt+1) + del )
               enddo
c
            endif
c						! all Z: get minima at high T
            flk_min(nt_alex) = flk_min(nt_alex)
     $           + 1.5 * min( 0.0 , flk_alex(1,nt_alex,kz,kx)
     $           - flk_alex(2,nt_alex,kz,kx) )
c
            do kt = nt_alex, kt_min + 1, -1
               flk_min(kt) = min( flk_min(min(kt+1,nt_alex)) ,
     $              flk_min(kt) ,
     $              flk_min(kt) + 1.5 * ( flk_alex(1,kt,kz,kx)
     $              - flk_alex(2,kt,kz,kx) ) )
            enddo
c
            if ( kz .eq. 1 ) kt_min = 1
c					! extrapolate logKappa in logRHO
            do kt = nt_alex, 1, -1
c
               del = flk_alex(1,kt,kz,kx) - flk_alex(2,kt,kz,kx)
               tmp = flk_alex(2,kt,kz,kx) - flk_alex(3,kt,kz,kx)
c								 ! Kappa-jump?
c							       ! => flat extrap
               if ( kz .gt. 1 .and. ( ( del * tmp .gt. 0.0 .and.
     $              abs( del ) .gt. max( 0.1 , 2. * abs( tmp ) ) ) .or.
     $              ( del * tmp .le. 0.0 .and. abs( del ) .gt.
     $              max( 0.1 , 1.5 * abs( tmp ) ) ) ) ) del = 0.0
c
c			! when logKappa smooth in logRHO, extrapolate linearly
c
               do kr = 0, nrlo_alex, -1
c							  ! but reduce increase
                  if ( del .gt. 0.0 .and. kt .ge. kt_min )
     $                 del = 0.7 * del
c						! check approach to minimum
                  flk_alex(kr,kt,kz,kx) =
     $                 max( flk_alex(kr+1,kt,kz,kx) + del ,
     $                 0.5 * ( flk_alex(kr+1,kt,kz,kx)
     $                 + flk_min(kt) ) )
c					  ! and check max allowed increase as T
c								    ! decreases
                  if ( kt .lt. min( kt_min , nt_alex - 2 ) ) then
                     tmp = max( flk_min(kt) ,
     $                    flk_alex(kr,kt+1,kz,kx) + dflkt_max(kt) )
                     if ( tmp .lt. flk_alex(kr,kt,kz,kx) ) then
                        flk_alex(kr,kt,kz,kx) = tmp
                        del = min( del , tmp - flk_alex(kr+1,kt,kz,kx) )
                        if ( kr .lt. 0 ) flk_alex(kr+1,kt,kz,kx) =
     $                       min( flk_alex(kr+1,kt,kz,kx) , 0.33 * tmp
     $                       + 0.67 * flk_alex(kr+2,kt,kz,kx) )
                     endif
                  endif
c
               enddo
c
            enddo
c
         enddo
c
      enddo
c
      kavail_alex = 1
      kdo_alex = kuse_alex
c			     ! if Alexander opacity-inclusion is set, make sure
c			     ! low-T OPAL limit is low enough for switchover
      if ( kdo_alex .gt. 0 )
     $     call set_logt6_limits( -99.0, -99.0, -99.0, -99.0 )
c
      return
      end
c
c******************************************************************************
c
      subroutine read_cond_pot( iu )
c     ==============================
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      parameter ( ndef_cond = 3 )
c
      character*255 cfile_cond
      character*80 cdef_cond(ndef_cond)
      common /c_filename_cond/ need_cond_dir, cfile_cond, cdef_cond
      save /c_filename_cond/
c
      if ( kavail_cond .le. 1 .and. cfile_cond .eq. ' ' )
     $     cfile_cond = ' PotONLY'
c
      call readcond( iu )
c					! if only have H&L, then try again
      if ( kavail_cond .le. 1 ) then
         kavail_cond = 0
         cfile_cond = ' PotONLY'
         call readcond( iu )
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine readcond( iu )
c     =========================
c
      parameter ( small_1m6=1.e-6, small_1m5=1.e-5, small_1m4=1.e-4 )
c
      double precision picon, fkbcon, clightcon, hbarcon,
     $     fkchcon, fkch3con, sigradcon, fkcondcon
      parameter ( picon=3.141592653589793d0, fkbcon=1.38066d-16,
     $     clightcon=2.99792458d+10, hbarcon=1.0545727d-27,
     $     fkchcon=fkbcon/(clightcon*hbarcon),
     $     fkch3con=fkchcon*fkchcon*fkchcon,
     $     sigradcon=picon*picon*fkbcon*fkch3con*clightcon/60.d0,
     $     fkcondcon=16.d0*sigradcon/3.d0 )

      parameter ( t0_pot=3.0, dt_pot=0.3333, r0_pot=-6.0, dr_pot=0.25 )
c
      parameter ( nT_KcPot=19, nR_KcPot=64, nZ_KcPot=15 )
c
      parameter ( ntlokc=37, ntlokcm1=ntlokc-1, nthikc=90-ntlokcm1,
     $     nrlokc=-23, nrlokcm1=nrlokc-1, nrhikc=24-nrlokcm1, nkc=3,
     $     nthikcm1=nthikc-1, nrhikcm1=nrhikc-1, nkcp1=nkc+1 )
      parameter ( dlt_kc=.1, dlr_kc=.25, dltinv_kc=10., dlrinv_kc=4. )
c
      character*2 celkc_hl(nkc)
      common /c_flkcond_hlpot/ flkc_pot(nT_KcPot,nR_KcPot,nZ_KcPot),
     $     AT_pot(nT_KcPot), AR_pot(nR_KcPot), AZ_pot(nZ_KcPot),
     $     sigconlog_pot, itlo_hl(nrhikc,nkc), ithi_hl(nrhikc,nkc),
     $     irhi_hl(nkc), itlo_ok_hl(nrhikc,nkc),
     $     irjump_hl(nkc), celkc_hl
      save /c_flkcond_hlpot/
c
      dimension flkc_hl(nthikc,nrhikc,nkc),
     $     flrolo_hl(nkc), flrohi_hl(nkc),
     $     fltlo_hl(nkc), flthi_hl(nkc),
     $     flRlo_hl(nkc), flRhi_hl(nkc), kZ_pot(nZ_KcPot)
      equivalence (flkc_pot(1,1,1),flkc_hl(1,1,1)),
     $     (AR_pot(1),flrolo_hl(1)), (AR_pot(nkcp1),flrohi_hl(1)),
     $     (AT_pot(1),fltlo_hl(1)), (AT_pot(nkcp1),flthi_hl(1)),
     $     (AZ_pot(1),flRlo_hl(1)), (AZ_pot(nkcp1),flRhi_hl(1)),
     $     (itlo_hl(1,1),kZ_pot(1))
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      parameter ( ndef_cond = 3 )
c
      character*255 cfile_cond
      character*80 cdef_cond(ndef_cond)
      common /c_filename_cond/ need_cond_dir, cfile_cond, cdef_cond
      save /c_filename_cond/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c
      parameter ( nitoh=5, nhl=4 )
c
      common /c_kcond_itoh/ ai_kc(nitoh), ax_kc(0:3,nitoh,3),
     $     bx_kc(0:2,nitoh,3), cx_kc(0:2,nitoh,3)
      save /c_kcond_itoh/
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
      common /c_pot_indices/ zkpot(0:3,0:3), zlg_pot_p, i1pot_p,
     $     i4pot_p, j1pot_p, j4pot_p, i1pot, i2pot, i3pot, i4pot,
     $     j1pot, j2pot, j3pot, j4pot, k1pot, k2pot, k3pot, k4pot
      save /c_pot_indices/
c-debug[
c-debug;      common /c_debug_kcond/ i_debug_kcond
c-debug;      save /c_debug_kcond/
c-debug]
c___
      character*255 cfile_use
c
      character*40 cin
c
      character*2 cst(4), ctmp
c
      dimension flk_in(nthikc), xi(5)
c===
      if ( iu .gt. 0 .and. iu .le. 99 ) iucond = iu
c
c					! if were already obtained, return
      if ( kavail_cond .ne. 0 ) return
c
      ifix_h_cond = ifix_h_cond_next
      itoh_gap = itoh_gap_next
c
      cst(1) = 'st'
      cst(2) = 'nd'
      cst(3) = 'rd'
      cst(4) = 'th'
c
      celkc_hl(1) = 'H '
      celkc_hl(2) = 'He'
      celkc_hl(3) = 'C '
c
c  Get the H&L or Potekhin conductive opacity file name, and open it:
c
      if ( need_cond_dir .gt. 0 ) then
         kx = lnblnk(copdir)
      else
         kx = 0
      endif
      kt = lnblnk(cfile_cond)
c					    ! check for error in directory name
      if ( kx .gt. 0 ) then
         if ( copdir(kx:kx) .ne. cb(1) .and.
     $        copdir(kx:kx) .ne. cb(2) ) then
            write(6,15) cb(1), cb(2), copdir(:kx)
 15         format(' READCOND Error: directory name does not end in "',
     $           a1,'" or "',a1,'":'/' ',a)
            stop ' STOP -- READCOND Error: directory name bad last char'
         endif
      endif
c							  ! blank? try defaults
      if ( kt .le. 0 .or. cfile_cond(1:1) .eq. ' ' ) then
c
         cfile_cond = ' '
         igzip = -99999
         i = ndef_cond
         kx = lnblnk(copdir)
         if ( kx .gt. 0 ) then
            if ( copdir(kx:kx) .ne. cb(1) .and.
     $           copdir(kx:kx) .ne. cb(2) ) kx = 0
         endif
         if ( kt .gt. 0 ) then
            ilo = 2
         else
            ilo = 1
         endif
c
         do while ( i .ge. ilo .and. igzip .eq. -99999 )
            kt = lnblnk( cdef_cond(i) )
            call open_chk_zip( -99999, cdef_cond(i), igzip, '???' )
            if ( igzip .ne. -99999 ) then
               kx = 0
               need_cond_dir = 0
               cfile_cond = cdef_cond(i)
            else if ( kx .gt. 0 ) then
               cfile_use = copdir(:kx) // cdef_cond(i)
               call open_chk_zip( -99999, cfile_use, igzip, '???' )
               if ( igzip .ne. -99999 ) then
                  need_cond_dir = 1
                  cfile_cond = cdef_cond(i)
               endif
            endif
            i = i - 1
         enddo
c
         if ( igzip .eq. -99999 ) then
            write(6,6)
 6          format(' READCOND Error: Cannot find any of the',
     $           ' default conductive opacity files:')
            do i = ndef_cond, ilo, -1
               write(6,7) cdef_cond(i)(:lnblnk(cdef_cond(i)))
 7             format(' ',a)
            enddo
            if ( kx .gt. 0 ) then
               write(6,8) copdir(:kx)
 8             format('                 in the local directory,',
     $              ' nor in the specified OPAL directory:'/' ',a)
            else
               write(6,9)
 9             format('                 in the local directory.')
            endif
            stop ' STOP -- READCOND Error: NO conductive opacity file.'
         endif
c
      endif
c					 ! directory + file name too long?
      if ( kx + kt .gt. 252 ) then
         if ( kx .gt. 0 ) then
            write(6,10) copdir(:kx), cfile_cond(:kt)
         else
            write(6,10) cfile_cond(:kt)
         endif
 10      format(' READCOND Error: directory + file name > 252 chars:'/
     $        ' ',a/' ',a)
         stop ' STOP -- READCOND Error: dir+file name > 252 chars. '
      endif
c				! combine directory and file name
      if ( kx .gt. 0 ) then
c
         cfile_use = copdir(:kx) // cfile_cond
         kt = kt + kx
c
      else
c
         cfile_use = cfile_cond
c
      endif
c
      cfile_opal_used(3) = cfile_use
c						       ! open the file
      call open_chk_zip( iucond, cfile_use, i_gzip,
     $     'READCOND Error: conductive opacity file not found.' )
c
c  Check the first line to see if this is the Potekhin conductive opacity file.
c    If so, go (to near the end of this subroutine) to read these in;
c    otherwise, read in the H&L conductive opacities logKcond
c
      line = 0
      linep = 0
      ngot = 0
c			! for each of the H&L tables (i.e., elements H, He, C):
      do kx = 1, nkc
c
         flRlo_hl(kx) = 99.
         flRhi_hl(kx) = -99.
c				! read the table-range values for this element
         line = line + 1
         read(iucond,'(a40)',end=990) cin
c						! is it a Potekhin 2006 file ?
         if ( kx .eq. 1 ) then
            if ( level_list .gt. 0 ) then
               if ( iu_list .eq. iucond ) then
                  write(6,4) iu_list
 4                format(/' ***OPAL WARNING: READCOND:',
     $                 ' bad LIST_IU =',i3,
     $                 ', reset to 6 (standard output)'/)
                  iu_list = 6
               endif
               if ( cin(1:7) .ne. ' -5.75 ' ) then
                  write(iu_list,1) cfile_use(:lnblnk(cfile_use))
 1                format(' ***OPAL/COND_Pot06: ',a)
                  goto 400
               else
                  write(iu_list,2) cfile_use(:lnblnk(cfile_use))
 2                format(' ***OPAL/COND_H&L: ',a)
               endif
            else if ( cin(1:7) .ne. ' -5.75 ' ) then
               goto 400
            endif
         endif
c
         read(cin,100,err=900,end=910) flrolo_hl(kx),
     $        flrohi_hl(kx), drho, dt,
     $        flthi_hl(kx), fltlo_hl(kx), ctmp
 100     format(6f6.2,1x,a2)
c						! check for errors in input
         linep = line
         if ( max( abs( drho - dlr_kc ) , abs( dt - dlt_kc ) )
     $        .gt. small_1m6 .or. flrolo_hl(kx) .ge.
     $        flrohi_hl(kx) .or. flthi_hl(kx) .le.
     $        fltlo_hl(kx) .or. ctmp .ne. celkc_hl(kx) ) goto 900
c
         krlo = nint( flrolo_hl(kx) * dlrinv_kc - nrlokcm1 )
         irhi_hl(kx) = nint( flrohi_hl(kx) * dlrinv_kc - nrlokcm1 )
c
         if ( krlo .ne. 1 .or. ( kx .gt. 1 .and.
     $        irhi_hl(kx) .ne. nrhikc ) .or. ( kx .eq. 1 .and.
     $        ( irhi_hl(kx) .gt. nrhikc .or.
     $        irhi_hl(kx) .lt. nrhikc - 4 ) ) ) goto 900
c								! for each RHO:
         do kr = 1, irhi_hl(kx)
c						! read logT, nT, some logKcond
            flro = ( kr + nrlokcm1 ) * dlr_kc
            ngot = 12
            line = line + 1
            read(iucond,200,err=920,end=930) flthi, numt,
     $           ( flk_in(i), i = 1, min( 12 , numt ) )
 200        format( f4.1, i3, 12f6.3 )
c						! check for errors in input
            linep = line
            if ( numt .lt. 2 .or. numt .gt. nthikc ) goto 920
            ngot = min( 12 , numt )
c						! set the T-range at this RHO
c
            ithi_hl(kr,kx) = nint( flthi * dltinv_kc - ntlokcm1 )
            ndel = ithi_hl(kr,kx) + 1
            itlo_hl(kr,kx) = ndel - numt
            if ( itlo_hl(kr,kx) .le. 0 .or.
     $           ithi_hl(kr,kx) .gt. nthikc ) goto 920
c						       ! REMOVE ANOMALOUS VALUE
            if ( kx .eq. min( 1 , ifix_h_cond ) .and.
     $           abs( flro + 0.5 ) .lt. small_1m4 ) then
               itlo_hl(kr,1) = max( itlo_hl(kr,1) ,
     $              nint( 5.5 * dltinv_kc - ntlokcm1 ) )
            endif
c
            itlo_ok_hl(kr,kx) = itlo_hl(kr,kx)
c						! update the table logR-range
            flRhi_hl(kx) = max( flRhi_hl(kx) ,
     $           flro - ( flthi - ( numt - 1 ) * dlt_kc - 6. ) * 3. )
            flRlo_hl(kx) = min( flRlo_hl(kx) ,
     $           flro - ( flthi - 6. ) * 3. )
c						! check for bad logKcond values
            nzer = 0
            do i = 1, ngot
               if ( flk_in(i) .eq. 0.0 ) then
                  if ( nzer .gt. 0 ) goto 920
                  nzer = nzer + 1
               else if ( flk_in(i) .lt. -30. .or.
     $                 flk_in(i) .gt. 30. ) then
                  goto 920
               endif
            enddo
c					! read any further lines at this RHO:
            do while ( ngot .lt. numt )
c					! read next line
               ngs = ngot + 1
               ngot = min( ngot + 12 , numt )
               line = line + 1
               read(iucond,250,err=940,end=930)
     $              ( flk_in(i), i = ngs, ngot )
 250           format( 7x, 12f6.3 )
c					! and check for bad logKcond values
               do i = ngs, ngot
                  if ( flk_in(i) .eq. 0.0 ) then
                     if ( nzer .gt. 0 ) goto 940
                     nzer = nzer + 1
                  else if ( flk_in(i) .lt. -30. .or.
     $                    flk_in(i) .gt. 30. ) then
                     goto 940
                  endif
               enddo
c
            enddo
c				! transfer input logKcond values into matrix
            do i = 1, numt
               flkc_hl(ndel-i,kr,kx) = flk_in(i)
            enddo
c
         enddo
c
      enddo
c							! close file when done
      call close_chk_zip( iucond, cfile_use, i_gzip )
c
c				! set "H&L conductive opacities available" flag
      kavail_cond = 1
      kdo_cond = kavail_cond * kuse_cond
c
c  Extend the logKcond values in a reasonable way into the areas of the H&L
c  matrix where nothing was read in.
c					     ! extend the high-RHO part of the
c			! H table to slightly lower T, using shape of He table
      krhi = irhi_hl(1)
      kr = krhi
c
      do while ( kr .gt. 1 .and.
     $     itlo_hl(kr,1) .le. itlo_hl(min(kr+1,krhi),1) .and.
     $     itlo_hl(kr,2) .le. itlo_hl(min(kr+1,nrhikc),2) )
c
         kt = itlo_hl(kr,1)
c
         if ( itlo_hl(kr,2) .lt. kt ) then
c
            del = flkc_hl(kt,kr,1) - flkc_hl(kt,kr,2)
c
            do kt = itlo_hl(kr,1) - 1, itlo_hl(kr,2), -1
               flkc_hl(kt,kr,1) = flkc_hl(kt,kr,2) + del
            enddo
c						! update O.K. T-range
            itlo_ok_hl(kr,1) = itlo_hl(kr,2)
c
         endif
c
         kr = kr - 1
c
      enddo
c			! fill any mini-gap just created (should not be needed)
      krat = kr + 1
c
      if ( itlo_hl(kr,1) .le. itlo_hl(krat,1) .and.
     $     itlo_hl(kr,1) .gt. itlo_ok_hl(krat,1) ) then
c
         ktlo = itlo_ok_hl(krat,1)
         krhi = kr
c						! find low edge of mini-gap
c
         do while ( kr .gt. 2 .and. itlo_hl(kr,1) .gt. ktlo .and.
     $        itlo_hl(kr-1,1) .le. itlo_hl(kr,1) )
            kr = kr - 1
         enddo
c
         krlim = kr
         ktlo = max( ktlo , itlo_hl(krlim,1) )
c							! for all T in the gap:
         do kt = itlo_hl(krhi,1) - 1, ktlo, -1
c						! find low edge at this T
            krlo = krat - 1
            do while ( krlo .gt. krlim .and.
     $           kt .lt. itlo_ok_hl(krlo,1) )
               krlo = krlo - 1
            enddo
c
            kthi = kt + 1
            del1 = flkc_hl(kt,krlo,1) - flkc_hl(kthi,krlo,1)
            del2 = flkc_hl(kt,krat,1) - flkc_hl(kthi,krat,1)
c								! fill the gap
            do kr = krlo + 1, krat - 1
               flkc_hl(kt,kr,1) = flkc_hl(kthi,kr,1)
     $              + ( ( krat - kr ) * del1 + ( kr - krlo ) * del2 )
     $              / ( krat - krlo )
               itlo_ok_hl(kr,1) = kt
            enddo
c
         enddo
c
      endif
c					! extend the H table to higher RHO,
c					! using the shape of the He table
      if ( krhi .lt. nrhikc ) then
c
         kthi = min( ithi_hl(krhi,1) , ithi_hl(krhi,2) )
         ktlo = max( itlo_ok_hl(krlo,1) , itlo_ok_hl(krlo,2) )
c
         do kr = krhi + 1, nrhikc
c
            ithi_hl(kr,1) = ithi_hl(kr,2)
            itlo_ok_hl(kr,1) = itlo_hl(kr,2)
            itlo_hl(kr,1) = itlo_hl(kr,2)
     $           + itlo_hl(krhi,1) - itlo_ok_hl(krhi,1)
c
            ktat = kthi
c
            do kt = ithi_hl(kr,2), itlo_hl(kr,2), -1
               flkc_hl(kt,kr,1) = flkc_hl(ktat,krhi,1)
     $              - flkc_hl(ktat,krhi,2) + flkc_hl(kt,kr,2)
               ktat = max( ktat - 1 , ktlo )
            enddo
c
         enddo
c
      endif
c			! for all three H&L tables (H, He, and C): extend...
      do kx = 1, nkc
c			! this initialization just prevents compiler warnings:
         ktlo = 0
c				! @maxRHO: extend to maxT (shouldn't be needed)
         kt = ithi_hl(nrhikc,kx)
         if ( kt .lt. nthikc ) then
            del1 = flkc_hl(kt,nrhikc,kx) - flkc_hl(kt-1,nrhikc,kx)
            del2 = max( 0.0 , flkc_hl(kt-1,nrhikc,kx)
     $           - flkc_hl(kt-2,nrhikc,kx) - del1 )
            do while ( kt .lt. nthikc )
               kt = kt + 1
               del2 = 0.5 * del2
               del1 = max( 0.5 * del1 , del1 - del2 )
               flkc_hl(kt,nrhikc,kx) = flkc_hl(kt-1,nrhikc,kx) + del1
            enddo
         endif
c				  ! fill in missing values at high T (low RHO):
         do kr = nrhikcm1, 1, -1
            do kt = ithi_hl(kr,kx) + 1, nthikc
               flkc_hl(kt,kr,kx) = flkc_hl(kt-1,kr,kx)
     $              + min( flkc_hl(kt,kr+1,kx)
     $              - flkc_hl(kt-1,kr+1,kx) ,
     $              flkc_hl(kt-1,kr,kx) -  flkc_hl(kt-2,kr,kx) )
            enddo
         enddo
c			       ! @minRHO: extend to minT (needed for He and C)
         kt = itlo_hl(1,kx)
         if ( kt .gt. 1 ) then
            del1 = flkc_hl(kt,1,kx) - flkc_hl(kt+1,1,kx)
            do while ( kt .gt. 1 )
               kthi = kt
               kt = kt - 1
               flkc_hl(kt,1,kx) = flkc_hl(kthi,1,kx) + del1
            enddo
         endif
c					! fill in "gap" at mid-RHO, low T:
         krhi = nrhikcm1
         do while ( krhi .gt. 2 .and.
     $        itlo_ok_hl(krhi-1,kx) .le. itlo_ok_hl(krhi,kx) )
            krhi = krhi - 1
         enddo
c
         krat = krhi
         do while ( krat .gt. 2 .and.
     $        itlo_ok_hl(krat-1,kx) .ge. itlo_ok_hl(krat,kx) )
            krat = krat - 1
         enddo
c
         if ( krat .lt. 2 ) stop
     $        ' STOP -- READCOND Error: bad mid-RHO gap: cannot be. '
c
         ktlim = itlo_ok_hl(krat,kx) - 1
c					 ! IF Itoh Kcond used in filling "gap":
c
         if ( itoh_replace .ge. 0 .and. itoh_gap .gt. 0 ) then
c
            do i = 1, 5
               xi(i) = 0.0
            enddo
            xi(kx) = 1.0
c							! for Hydrogen:
            if ( kx .eq. 1 ) then
c
               krlo = nint( 1.25 * dlrinv_kc ) - nrlokcm1
               krat = nint( 2.0 * dlrinv_kc ) - nrlokcm1
               krit = krlo - 1
c					    ! for logRHO = 1.25, 1.5, 1.75, 2.0
               do while ( krit .lt. krat )
c					   ! set to approx logKc(Itoh) at low T
                  krit = krit + 1
c
                  if ( krit .lt. krhi ) stop
     $                 ' STOP -- READCOND Error: bad RHO(H) cannot be.'
c
c					! set dKc = logKc(H&L) - logKc(Itoh)
c							! at Tmin(H&L)
                  flro = ( krit + nrlokcm1 ) * dlr_kc
                  kt = itlo_ok_hl(krit,1)
                  flt = ( kt + ntlokcm1 ) * dlt_kc
                  call kapcond( flro, flt, xi(1), xi(2), xi(3),
     $                 xi(4), xi(5), -9., -9., -9., -1,
     $                 del2, flkct, flkcro, fkcedge, fkcok )
                  del1 = flkc_hl(kt,krit,kx) - del2
c							! at all lower T values
                  do kt = itlo_ok_hl(krit,1) - 1, 1, -1
c							! reduce dKc magnitude
                     if ( del1 .lt. 0.0 ) then
                        del1 = min( del1 + 0.05 , 0.5 * del1 )
                     else
                        del1 = max( del1 - 0.05 , 0.5 * del1 )
                     endif
c				 ! set logKc(H&L) = logKc(Itoh) + dKc  [goes to
c							! logKc(Itoh) at low T]
                     flt = ( kt + ntlokcm1 ) * dlt_kc
                     call kapcond( flro, flt, xi(1), xi(2), xi(3),
     $                    xi(4), xi(5), -9., -9., -9., -1,
     $                    del2, flkct, flkcro, fkcedge, fkcok )
                     flkc_hl(kt,krit,kx) = del2 + del1
c
                  enddo
c
               enddo
c
               krhiat = krlo
c						! for Helium and Carbon:
            else
c							  ! for logRHO = 1.5
               krit = nint( 1.5 * dlrinv_kc ) - nrlokcm1
c
               if ( krat .lt. krhi - 1 ) stop
     $              ' STOP -- READCOND Error: bad krat cannot be. '
c
               ktlo = 0
               fkcedge = 0.0
               flro = ( krit + nrlokcm1 ) * dlr_kc
               kthi = itlo_ok_hl(krit,kx)
c					     ! set to logKc(Itoh) at very low T
               do while ( fkcedge .eq. 0.0 )
                  ktlo = ktlo + 1
                  if ( ktlo .ge. itlo_ok_hl(krit,kx) ) stop
     $                 ' STOP -- READCOND Error: bad ktlo cannot be. '
                  flt = ( ktlo + ntlokcm1 ) * dlt_kc
                  call kapcond( flro, flt, xi(1), xi(2), xi(3),
     $                 xi(4), xi(5), -9., -9., -9., -1,
     $                 flkc_hl(ktlo,krit,kx),
     $                 flkct, flkcro, fkcedge, fkcok )
               enddo
c					     ! and up to Tmax(Itoh) < Tmin(H&L)
               do while ( fkcedge .gt. 0.0 )
                  ktlo = ktlo + 1
                  if ( ktlo .ge. kthi ) stop
     $                 ' STOP -- READCOND Error: bad ktlo cannot be. '
                  flt = ( ktlo + ntlokcm1 ) * dlt_kc
                  call kapcond( flro, flt, xi(1), xi(2), xi(3),
     $                 xi(4), xi(5), -9., -9., -9., -1,
     $                 flkc_hl(ktlo,krit,kx),
     $                 flkct, flkcro, fkcedge, fkcok )
               enddo
               ktlo = ktlo - 1
c					  ! interp: Tmax(Itoh) up to Tmin(H&L)
               do kt = ktlo + 1, kthi - 1
                  flkc_hl(kt,krit,kx) =
     $                 ( ( kthi - kt ) * flkc_hl(ktlo,krit,kx)
     $                 + ( kt - ktlo ) * flkc_hl(kthi,krit,kx) )
     $                 / ( kthi - ktlo )
               enddo
c			 ! fill "gap" at logRHO > 1.5, for all T down to lowest
c						      ! Tmin(H&L)[logRHO > 1.5]
               do kt = ktlim, itlo_ok_hl(krhi,kx), -1
c						      ! find gap high-RHO edge
                  krat = krhi
                  do while ( krat .gt. krit .and.
     $                 kt .ge. itlo_ok_hl(krat,kx) )
                     krat = krat - 1
                  enddo
c						      ! if gap exists at this T
                  if ( krat .gt. krit ) then
c						      ! find gap low-RHO edge
                     krlo = krat
                     krat = krat + 1
c
                     do while ( krlo .gt. krit .and.
     $                    kt .lt. itlo_ok_hl(krlo,kx) )
                        krlo = krlo - 1
                     enddo
c
                     kthi = kt + 1
                     del1 = flkc_hl(kt,krlo,kx) - flkc_hl(kthi,krlo,kx)
                     del2 = flkc_hl(kt,krat,kx) - flkc_hl(kthi,krat,kx)
c								       ! & fill
                     do kr = krlo + 1, krat - 1
                        flkc_hl(kt,kr,kx) = ( flkc_hl(kthi,kr,kx)
     $                       + ( ( krat - kr ) * del1
     $                       + ( kr - krlo ) * del2 )
     $                       / ( krat - krlo ) )
                     enddo
c
                  endif
c
               enddo
c				      ! Carbon: let T1 = Tmax(Itoh)[logRHO=1.5]
               if ( kx .eq. 3 ) then
c					       ! let T2 = Tmin(H&L)[logRHO>1.5]
                  ktloat = itlo_ok_hl(krhi,kx)
c					      ! at higher RHO along Tmax(Itoh):
                  do kr = krit + 1, krhi - 1
c					      ! for this RHO: start at T1
                     ktat = ktlo
                     flro = ( kr + nrlokcm1 ) * dlr_kc
                     flt = ( ktat + ntlokcm1 ) * dlt_kc
                     call kapcond( flro, flt, xi(1), xi(2), xi(3),
     $                    xi(4), xi(5), -9., -9., -9., -1,
     $                    flkc, flkct, flkcro, fkcedge, fkcok )
c							       ! store Kc(Itoh)
                     del1 = flkc - flkc_hl(ktat,kr,kx)
                     if ( kr .eq. krhi - 1 ) del1 = 0.5 * del1
c
                     flkc_hl(ktat,kr,kx) = flkc_hl(ktat,kr,kx) + del1
c
c							! interp T1 down to T2
                     if ( ktloat .lt. ktat - 1 ) then
                        del2 = del1 / ( ktat - ktloat )
                        do kt = ktloat + 1, ktat - 1
                           flkc_hl(kt,kr,kx) = flkc_hl(kt,kr,kx)
     $                          + ( kt - ktloat ) * del2
                        enddo
                     endif
c
                     kthiat = itlo_ok_hl(kr,kx)
c						  ! for T up to Tmax(Itoh)[RHO]
                     do while ( fkcedge .gt. 0.0 )
c							  ! store logKc(Itoh)
                        ktat = ktat + 1
                        if ( ktat .ge. kthiat ) stop
     $                       ' STOP -- READCOND Error: bad ktat cannot'
                        flt = ( ktat + ntlokcm1 ) * dlt_kc
                        call kapcond( flro, flt, xi(1), xi(2), xi(3),
     $                       xi(4), xi(5), -9., -9., -9., -1,
     $                       flkc, flkct, flkcro, fkcedge, fkcok )
                        if ( fkcedge .gt. 0.0 ) then
                           del1 = flkc - flkc_hl(ktat,kr,kx)
                           if ( kr .eq. krhi - 1 ) del1 = 0.5 * del1
                           flkc_hl(ktat,kr,kx) = flkc_hl(ktat,kr,kx)
     $                          + del1
                        endif
c
                     enddo
c				  ! interp Tmax(Itoh)[RHO] up to Tmin(H&L)[RHO]
                     ktat = ktat - 1
                     del2 = del1 / ( kthiat - ktat )
c
                     do kt = ktat + 1, kthiat - 1
                        flkc_hl(kt,kr,kx) = flkc_hl(kt,kr,kx)
     $                       + ( kthiat - kt ) * del2
                     enddo
c
                  enddo
c
               endif
c
               ktlim = itlo_ok_hl(krit-1,kx) - 1
               krhiat = krit
c
            endif
c				    ! for Hydrogen, Helium, and Carbon:
c					! for all temperatures T in "gap"
            do kt = ktlim, 1, -1
c
               d_hi = 0.8
               d_lo = 0.2
               if ( kx .eq. 3 .or. kx .eq. 2 ) then
                  if ( kt .ge. ktlo ) then
                     kr1 = - nrlokcm1
                  else
                     kr1 = max( 1 ,
     $                    nint( ( kt - ktlo ) * 0.25 - nrlokcm1 ) )
                     d_hi = 0.9
                     d_lo = 0.1
                  endif
                  kr2 = krhiat
                  do while ( kr1 .lt. krhiat .and.
     $                 kt .ge. itlo_ok_hl(min(kr1+1,nrhikc),kx) )
                     kr1 = kr1 + 1
                  enddo
               else if ( kx .eq. 1 ) then
                  kr2 = nint( 0.75 * dlrinv_kc ) - nrlokcm1
                  if ( kt .ge. itlo_ok_hl(kr2,kx) ) then
                     kr1 = nint( -1.0 * dlrinv_kc ) - nrlokcm1
                     do while ( kr1 .lt. kr2 .and.
     $                    kt .ge. itlo_ok_hl(min(kr1+1,nrhikc),kx) )
                        kr1 = kr1 + 1
                     enddo
                  else
                     kr1 = kr2 - 1
                     kr2 = krhiat
                  endif
               else
                  kr1 = nrhikc
                  kr2 = 0
               endif
c				  ! for all densities below where used Kc(Itoh)
c				  ! find upper RHO-edge of gap at highest RHO
               krat = krhiat - 1
               do while ( krat .gt. 1 .and.
     $              kt .ge. itlo_ok_hl(krat,kx) )
                  krat = krat - 1
               enddo
c						! find and fill any gaps
               do while ( krat .gt. 2 )
c					! find lower RHO-edge of gap
                  krlo = krat
                  krat = krat + 1
c
                  do while ( krlo .gt. 1 .and.
     $                 kt .lt. itlo_ok_hl(krlo,kx) )
                     krlo = krlo - 1
                  enddo
c					! and fill it for all RHO in gap
                  kthi = kt + 1
                  del1 = flkc_hl(kt,krlo,kx) - flkc_hl(kthi,krlo,kx)
                  del2 = flkc_hl(kt,krat,kx) - flkc_hl(kthi,krat,kx)
c								 ! fill gap @ T
                  do kr = krlo + 1, krat - 1
                     flkc_hl(kt,kr,kx) = ( flkc_hl(kthi,kr,kx)
     $                    + ( ( krat - kr ) * del1
     $                    + ( kr - krlo ) * del2 )
     $                    / ( krat - krlo ) )
                     if ( kr .gt. kr1 .and. kr .lt. kr2 )
     $                    flkc_hl(kt,kr,kx) = d_hi * flkc_hl(kt,kr,kx)
     $                    + d_lo * ( ( kr2 - kr ) * flkc_hl(kt,kr1,kx)
     $                    + ( kr - kr1 ) * flkc_hl(kt,kr2,kx) )
     $                    / ( kr2 - kr1 )
                  enddo
c				  ! find upper RHO-edge of next gap, if any
                  krat = krlo
                  do while ( krat .gt. 1 .and.
     $                 kt .ge. itlo_ok_hl(krat,kx) )
                     krat = krat - 1
                  enddo
c
               enddo
c
            enddo
c			! (set the definition of high RHO, low T for below)
            krat = krit
            if ( kx .eq. 1 ) then
               ktlim = nthikc
            else
               ktlim = itlo_ok_hl(krhi,kx) - 1
            endif
c			       ! ELSE: if Itoh Kcond NOT used in filling "gap":
         else
c
            ktlo = itlo_ok_hl(krhi,kx)
c							! for all T in the gap:
            do kt = ktlim, ktlo, -1
c						! find edges of gap at this T
               krlo = krat - 1
c								! find low edge
               do while ( krat .lt. krhi .and.
     $              kt .lt. itlo_ok_hl(krat,kx) )
                  krat = krat + 1
               enddo
c								       ! & high
               do while ( krlo .gt. 1 .and.
     $              kt .lt. itlo_ok_hl(krlo,kx) )
                  krlo = krlo - 1
                  if ( itlo_ok_hl(krlo,kx) .gt.
     $                 itlo_ok_hl(krlo+1,kx) ) stop
     $                 ' STOP -- READCOND Error: ragged bottom cannot.'
               enddo
c
               if ( kt .lt. itlo_ok_hl(krlo,kx) ) stop
     $              ' STOP -- READCOND Error: bad mid-RHO gap cannot. '
c
               kthi = kt + 1
               del1 = flkc_hl(kt,krlo,kx) - flkc_hl(kthi,krlo,kx)
               del2 = flkc_hl(kt,krat,kx) - flkc_hl(kthi,krat,kx)
c								 ! fill gap @ T
               do kr = krlo + 1, krat - 1
                  flkc_hl(kt,kr,kx) = flkc_hl(kthi,kr,kx)
     $                 + ( ( krat - kr ) * del1
     $                 + ( kr - krlo ) * del2 )
     $                 / ( krat - krlo )
               enddo
c
            enddo
c						! find RHO just above gap
            krhi = nrhikc
            do while ( krhi .gt. 1 .and. itlo_ok_hl(max(1,krhi-1),kx)
     $           .lt. itlo_ok_hl(krhi,kx) )
               krhi = krhi - 1
            enddo
c
            ktlim = nthikc
c
            if ( krhi .gt. 1 ) then
c					  ! @RHO just above gap: extend to minT
               kt = itlo_ok_hl(krhi,kx)
               del1 = flkc_hl(kt,krhi,kx) - flkc_hl(kt+1,krhi,kx)
               del2 = flkc_hl(kt+1,krhi,kx) - flkc_hl(kt+2,krhi,kx)
     $              - del1
               do while ( kt .gt. 1 )
                  kthi = kt
                  kt = kt - 1
                  del2 = 0.5 * del2
                  del1 = del1 - del2
                  flkc_hl(kt,krhi,kx) = flkc_hl(kthi,krhi,kx) + del1
               enddo
c				! fill the new gap created by this extension
               krlo = krhi - 1
               do kt = itlo_ok_hl(krhi,kx) - 1, 1, -1
                  kthi = kt + 1
                  do while ( krlo .gt. 1 .and.
     $                 kt .lt. itlo_ok_hl(krlo,kx) )
                     krlo = krlo - 1
                  enddo
                  del1 = flkc_hl(kt,krlo,kx) - flkc_hl(kthi,krlo,kx)
                  del2 = flkc_hl(kt,krhi,kx) - flkc_hl(kthi,krhi,kx)
                  do kr = krlo + 1, krhi - 1
                     flkc_hl(kt,kr,kx) = flkc_hl(kthi,kr,kx)
     $                    + ( ( krhi - kr ) * del1
     $                    + ( kr - krlo ) * del2 ) / ( krhi - krlo )
                  enddo
               enddo
c
               ktlim = itlo_ok_hl(krhi,kx)
c
            endif
c
            krat = krhi
c			       ! (end of "gap" Itoh Kcond alternatives)
         endif
c				  ! IN ALL CASES:
c				  ! fill in missing values at high RHO, low T:
         do kr = krat + 1, nrhikc
            krlo = kr - 1
            kthi = itlo_ok_hl(kr,kx) - 1
            if ( kr .le. krhi ) kthi = min( kthi , ktlim )
            do kt = kthi, 1, -1
               flkc_hl(kt,kr,kx) = flkc_hl(kt+1,kr,kx)
     $              + min( flkc_hl(kt,krlo,kx)
     $              - flkc_hl(kt+1,krlo,kx) ,
     $              flkc_hl(kt+2,kr,kx) - flkc_hl(kt+1,kr,kx) )
            enddo
         enddo
c
      enddo
c
      call find_rjump_hl_cond
c						! DONE: return
      return
c
 900  write(6,905) line, kx, celkc_hl(kx)
 905  format(' READCOND Error (file line',i4,
     $     '): bad table-range values beginning element_',i1,'= ',a2)
      if ( linep .eq. line ) write(6,907) flrolo_hl(kx),
     $     flrohi_hl(kx), drho, dt,
     $     flthi_hl(kx), fltlo_hl(kx), ctmp
 907  format(' READCOND Error: logRHO',f6.2,' :',f6.2,' dlogRHO,T',
     $     2f5.2,' logT',2f5.2,' for ',a2)
      write(6,908) cfile_use(:lnblnk(cfile_use))
 908  format(' ',a)
      stop ' STOP -- READCOND Error: bad H&L table-range values. '
c
 990  continue
      if ( line .eq. 1 ) then
         write(6,995) cfile_use(:lnblnk(cfile_use))
 995     format(' READCOND Error: unexpected EOF',
     $        ' at beginning of conductive opacity file:'/' ',a)
         stop ' STOP -- READCOND Error: EOF at beginning of file. '
      endif
c
 910  write(6,915) line, kx, celkc_hl(kx)
 915  format(' READCOND Error (file line',i4,
     $     '): unexpected EOF at beginning of element_',i1,'= ',a2)
      write(6,908) cfile_use(:lnblnk(cfile_use))
      stop ' STOP -- READCOND Error: EOF (missing H&L Kcond table). '
c
 920  write(6,925) line, kx, celkc_hl(kx), kr
 925  format(' READCOND Error (file line ',i4,'): element_',i1,'=',a2,
     $     ' @ logRHO_',i2.2,': bad logT,nT,logKcond')
      if ( linep .eq. line ) write(6,927) flro, flthi, numt,
     $     ithi_hl(kr,kx), itlo_hl(kr,kx), ';',
     $     ( ' ', flk_in(i), i = 1, ngot )
 927  format(' READCOND Error (logRHO',f6.2,'): logThi',f5.1,
     $     '  nT',i4,' (index',i3,' :',i3,')',a,a1,' logKcond:',
     $     2(/' READCOND Error:  ',6(f9.5,a1)))
      write(6,908) cfile_use(:lnblnk(cfile_use))
      stop ' STOP -- READCOND Error: H&L table: bad logT,nT,logKcond. '
c
 930  write(6,935) line, kx, celkc_hl(kx), kr, flro,
     $     1 + (ngot-1)/12, cst( min( 4 , 1 + (ngot-1)/12 ) )
      if ( ngot .gt. 12 ) write(6,927) dlr_kc * ( kr + nrlokcm1 ),
     $     flthi, numt, ithi_hl(kr,kx), itlo_hl(kr,kx),
     $     ': ... EOF'
 935  format(' READCOND Error (file line',i4,
     $     '): EOF: element_',i1,'=',a2,
     $     ' @ logRHO_',i2.2,'=',f6.2,':',i2,a2,'-line')
      write(6,908) cfile_use(:lnblnk(cfile_use))
      stop ' STOP -- READCOND Error: EOF (in H&L Kcond table). '
c
 940  write(6,945) line, kx, celkc_hl(kx), kr, 1 + (ngot-1)/12,
     $     cst( min( 4 , 1 + (ngot-1)/12 ) )
 945  format(' READCOND Error (file line',i4,'): element_',i1,'=',a2,
     $     ' bad logKcond @ logRHO_',i2.2,':',i1,a2,'-line')
      write(6,927) flro, flthi, numt,
     $     ithi_hl(kr,kx), itlo_hl(kr,kx), ';',
     $     ( ' ', flk_in(i), i = 1, ngot )
      write(6,908) cfile_use(:lnblnk(cfile_use))
      stop ' STOP -- READCOND Error: H&L table: bad logKcond value. '
c
c  Alternative part: read in Potekhin file (note 1st line already skipped):
c
 400  continue
c				! for each Z
      do iz = 1, nZ_KcPot
c
         line = line + 1
c
         read(iucond,*,err=800,end=810) z_pot,
     $        ( AT_pot(it), it = 1, nT_KcPot )
cREADCOND Error (Potekhin file line 123): bad at.no. z_nuc(12) = -1.1234567e-12
         if ( z_pot .lt. 1.0 .or. z_pot .gt. 130.0 .or.
     $        ( iz .eq. 1 .and. z_pot .ne. 1.0 ) .or.
     $        abs( z_pot - nint(z_pot) ) .gt. small_1m5 ) then
            write(6,700) line, iz, z_pot
 700        format(' READCOND Error (Potekhin file line',i4,
     $           '): bad at.no. z_nuc(',i2.2,') =',1p,e15.7)
            stop ' STOP -- READCOND Error: Potekhin file: bad z_nuc. '
         endif
c
         AZ_pot(iz) = log10( z_pot )
         kZ_pot(iz) = nint( z_pot )
c					! note logT spacing is NOT even:
c					! d logT = 0.333 0.334 0.333 0.333 ...
         do it = 2, nT_KcPot
            if ( abs( AT_pot(it) - AT_pot(it-1) - dt_pot ) .gt. 0.001
     $           .or. abs( AT_pot(1) - t0_pot ) .gt. small_1m6 ) then
cREADCOND Error (Potekhin file line 123): bad logT values for z_nuc(12) = 123:
cREADCOND Error:  should be logT = 3.0 (1/3) 9.0, but input was:  logT =  3.000
cREADCOND Error:  3.333  3.667  4.000  4.333  4.667  5.000  5.333  5.667  6.000
cREADCOND Error:  6.333  6.667  7.000  7.333  7.667  8.000  8.333  8.667  9.000
               write(6,710) line, iz, kZ_pot(iz),
     $              ( AT_pot(i), i = 1, nT_KcPot )
 710           format(' READCOND Error (Potekhin file line',i4,
     $              '): bad logT values for z_nuc(',i2.2,') =',i4,':'/
     $              ' cREADCOND Error:  should be logT = 3.0 (1/3)',
     $              ' 9.0, but input was:  logT =',f7.3,
     $              2(/' READCOND Error:',9f7.3))
               write(6,908) cfile_use(:lnblnk(cfile_use))
               stop ' STOP -- READCOND Error: Potekhin file: bad T. '
            endif
         enddo
c					! for each RHO
         do ir = 1, nR_KcPot
c							! read in all T-values
            line = line + 1
            read(iucond,*,err=800,end=810) AR_pot(ir),
     $           ( flkc_pot(it,ir,iz), it = 1, nT_KcPot )
c
            if ( ( ir .eq. 1 .and.
     $           abs( AR_pot(ir) - r0_pot ) .gt. small_1m5 ) .or.
     $           ( ir .gt. 1 .and. abs( AR_pot(ir)
     $           - AR_pot(max(ir-1,1)) - dr_pot ) .gt.
     $           small_1m5 ) ) then
cREADCOND Error (Potekhin file line 123): bad logRHO value for z_nuc(12) = 123:
cREADCOND Error:  should be logRHO = -12.123456: bad input  logRHO = -12.123456
               if ( ir .eq. 1 ) then
                  write(6,720) line, iz, kZ_pot(iz), r0_pot, AR_pot(ir)
               else
                  write(6,720) line, iz, kZ_pot(iz),
     $                 AR_pot(ir-1) + dr_pot, AR_pot(ir)
               endif
 720           format(' READCOND Error (Potekhin file line',i4,
     $              '): bad logRHO value for z_nuc(',i2.2,') =',i4,':'/
     $              ' READCOND Error:  should be logRHO =',f11.6,
     $              ': bad input  logRHO =',f11.6)
               write(6,908) cfile_use(:lnblnk(cfile_use))
               stop ' STOP -- READCOND Error: Potekhin file: bad RHO. '
            endif
c
         enddo
c
      enddo
c							! close file when done
      call close_chk_zip( iucond, cfile_use, i_gzip )
c
c			! set "Potekhin conductive opacities available" flag
      kavail_cond = 2
      kdo_cond = kavail_cond * kuse_cond
c					 ! to convert conductivity to opacity
      sigconlog_pot = log10( fkcondcon )
c					 ! clear cache
      i1pot_p = 0
      i4pot_p = -1
      j1pot_p = 0
      j4pot_p = -1
      zlg_pot_p = -1.e30
c
      return
c
cREADCOND Error (Potekhin file line 123): error reading input values.
 800  write(6,805) line
 805  format(' READCOND Error (Potekhin file line',i4,
     $     '): error reading input values.')
      write(6,908) cfile_use(:lnblnk(cfile_use))
      stop ' STOP -- READCOND Error: Potekhin file read error. '
c
cREADCOND Error (Potekhin file line 123): unexpected end of file.
 810  write(6,815) line
 815  format(' READCOND Error (Potekhin file line',i4,
     $     '): unexpected end of file.')
      write(6,908) cfile_use(:lnblnk(cfile_use))
      stop ' STOP -- READCOND Error: unexpected EOF (in Potekhin file)'
c
      end
c
c******************************************************************************
c
      subroutine find_rjump_hl_cond
c     =============================
c
      parameter ( nT_KcPot=19, nR_KcPot=64, nZ_KcPot=15 )
c
      parameter ( ntlokc=37, ntlokcm1=ntlokc-1, nthikc=90-ntlokcm1,
     $     nrlokc=-23, nrlokcm1=nrlokc-1, nrhikc=24-nrlokcm1, nkc=3,
     $     nthikcm1=nthikc-1, nrhikcm1=nrhikc-1, nkcp1=nkc+1 )
      parameter ( dlt_kc=.1, dlr_kc=.25, dltinv_kc=10., dlrinv_kc=4. )
c
      character*2 celkc_hl(nkc)
      common /c_flkcond_hlpot/ flkc_pot(nT_KcPot,nR_KcPot,nZ_KcPot),
     $     AT_pot(nT_KcPot), AR_pot(nR_KcPot), AZ_pot(nZ_KcPot),
     $     sigconlog_pot, itlo_hl(nrhikc,nkc), ithi_hl(nrhikc,nkc),
     $     irhi_hl(nkc), itlo_ok_hl(nrhikc,nkc),
     $     irjump_hl(nkc), celkc_hl
      save /c_flkcond_hlpot/
c
      dimension flkc_hl(nthikc,nrhikc,nkc),
     $     flrolo_hl(nkc), flrohi_hl(nkc),
     $     fltlo_hl(nkc), flthi_hl(nkc),
     $     flRlo_hl(nkc), flRhi_hl(nkc), kZ_pot(nZ_KcPot)
      equivalence (flkc_pot(1,1,1),flkc_hl(1,1,1)),
     $     (AR_pot(1),flrolo_hl(1)), (AR_pot(nkcp1),flrohi_hl(1)),
     $     (AT_pot(1),fltlo_hl(1)), (AT_pot(nkcp1),flthi_hl(1)),
     $     (AZ_pot(1),flRlo_hl(1)), (AZ_pot(nkcp1),flRhi_hl(1)),
     $     (itlo_hl(1,1),kZ_pot(1))
c
      do kc = 1, nkc
         ir = irhi_hl(kc)
         do while ( ir .gt. 2 .and.
     $        itlo_hl(ir-1,kc) .le. itlo_hl(ir,kc) )
            ir = ir - 1
            if ( ir .eq. 2 ) stop
     $           ' STOP -- find_rjump_hl_cond Error: ir=2 cannot be. '
         enddo
         irjump_hl(kc) = ir
      enddo
c
      return
      end
c
c******************************************************************************
c
      subroutine dump_opal_opac( iu_out, cf_d )
c     =========================================
c
      character*(*) cf_d
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/c_opal_ctrl_smooth/ init_smo, low_CO_smo, interp_CO_smo
      save /c_opal_ctrl_smooth/
c
      common /alt_change_opal_z/ main_alt_change, iulow, khighz_in,
     $     ofebrack_in
      save /alt_change_opal_z/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mo_m2=mo-2 )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c
      character*80 cdef_CNO_ext(n_cnobeg:n_totmix)
      common /ext_CNO_opal_z/ len_def_CNO_ext(n_cnobeg:n_totmix),
     $     cdef_CNO_ext
      save /ext_CNO_opal_z/
c
      common /cno_delta_opal_z/ fcno_mul(4), fninz_cno(nel_zmix,5),
     $     xiz_cno(nel_zmix,5), d_fninz_user(nel_zmix),
     $     fcno_fac(0:3,4), fninz_heavy, xiz_heavy, d_fninz_u_heavy,
     $     s_ninzai_mix, ds_ninzai_u, fn_o_over_cno, fninz_co_mix
      save /cno_delta_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      parameter ( zdel=0.001, xdel=0.03, xdelmin=0.001 )
c
      parameter ( mz=8, mz_m1=mz-1, mz_m2=mz-2, mzhi=11, mzal=13,
     $     nzm=mzal+1, nadd_zavail=nzm-mz )
c
      common/zinter_opal_z/ zvalhi(mzhi),nofz(mzhi,5,mo),mnofz(mx),
     $     zval(mz),zalval(mzal),zavail(nzm),iadd_zavail(nadd_zavail)
      save /zinter_opal_z/
c
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c
      common/alink_opal_z/ NTEMP,NSM,nrlow,nrhigh,RLE,t6arr(100),
     $     coff(100,nrm)
      save /alink_opal_z/
c
      character*4 cxfil(5),czfil(mz)
      common/czinte_opal_z/ cxfil,czfil
      save /czinte_opal_z/
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /mat_alex_ferg/ flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg)
      save /mat_alex_ferg/
      dimension flk_alex(nrlo_alex:nr_alex,nt_alex,nzp1_alex,nx_alex)
      equivalence (flk_alex(nrlo_alex,1,1,1),flk_ferg(1,1,1,1))
c
      common /opac_alex/ zlog_alex(nzp1_alex),xlog_alex(nx_alex),
     $     dzinvlog_alex(nzp1_alex),dxinvlog_alex(nx_alex)
      save /opac_alex/
c
      common /opac_ferg/ zlog_ferg(nzp1_ferg), xlog_ferg(nx_ferg),
     $     dzinvlog_ferg(nz_ferg), dzinv_ferg(nz_ferg),
     $     dxinvlog_ferg(nx_ferg), dxinv_ferg(nx_ferg),
     $     t6log_ferg(nt_ferg), rlog_ferg(nr_ferg),
     $     dt6inv_ferg(nt_ferg), drinv_ferg(nr_ferg),
     $     modt_ferg, modz0_ferg, ntuferg
      save /opac_ferg/
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_ofe_in_ferg/ ofein_ferg, i_ofe_ferg, i_ofe0_ferg
      save /c_ofe_in_ferg/
c
      common /c_prev_ferg/ zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $     zlp2_ferg, xp2_ferg, i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
      save /c_prev_ferg/
c
      common /c_tsw_ferg/ slt_max_ferg, sltswlo_ferg_def,
     $     sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $     sltswmid_ferg, dltsw2inv_ferg
      save /c_tsw_ferg/
c
      character*255 cfile_alex
      common /c_filename_alex/ need_alex_dir, cfile_alex
      save /c_filename_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      parameter ( nT_KcPot=19, nR_KcPot=64, nZ_KcPot=15 )
c
      parameter ( ntlokc=37, ntlokcm1=ntlokc-1, nthikc=90-ntlokcm1,
     $     nrlokc=-23, nrlokcm1=nrlokc-1, nrhikc=24-nrlokcm1, nkc=3,
     $     nthikcm1=nthikc-1, nrhikcm1=nrhikc-1, nkcp1=nkc+1 )
      parameter ( dlt_kc=.1, dlr_kc=.25, dltinv_kc=10., dlrinv_kc=4. )
c
      character*2 celkc_hl(nkc)
      common /c_flkcond_hlpot/ flkc_pot(nT_KcPot,nR_KcPot,nZ_KcPot),
     $     AT_pot(nT_KcPot), AR_pot(nR_KcPot), AZ_pot(nZ_KcPot),
     $     sigconlog_pot, itlo_hl(nrhikc,nkc), ithi_hl(nrhikc,nkc),
     $     irhi_hl(nkc), itlo_ok_hl(nrhikc,nkc),
     $     irjump_hl(nkc), celkc_hl
      save /c_flkcond_hlpot/
c
      dimension flkc_hl(nthikc,nrhikc,nkc),
     $     flrolo_hl(nkc), flrohi_hl(nkc),
     $     fltlo_hl(nkc), flthi_hl(nkc),
     $     flRlo_hl(nkc), flRhi_hl(nkc), kZ_pot(nZ_KcPot)
      equivalence (flkc_pot(1,1,1),flkc_hl(1,1,1)),
     $     (AR_pot(1),flrolo_hl(1)), (AR_pot(nkcp1),flrohi_hl(1)),
     $     (AT_pot(1),fltlo_hl(1)), (AT_pot(nkcp1),flthi_hl(1)),
     $     (AZ_pot(1),flRlo_hl(1)), (AZ_pot(nkcp1),flRhi_hl(1)),
     $     (itlo_hl(1,1),kZ_pot(1))
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      common /c_pot_indices/ zkpot(0:3,0:3), zlg_pot_p, i1pot_p,
     $     i4pot_p, j1pot_p, j4pot_p, i1pot, i2pot, i3pot, i4pot,
     $     j1pot, j2pot, j3pot, j4pot, k1pot, k2pot, k3pot, k4pot
      save /c_pot_indices/
c
      parameter ( ndef_cond = 3 )
c
      character*255 cfile_cond
      character*80 cdef_cond(ndef_cond)
      common /c_filename_cond/ need_cond_dir, cfile_cond, cdef_cond
      save /c_filename_cond/
c===
      if ( itime .ne. 12345678 ) stop
     $     ' STOP -- DUMP_OPAL_OPAC: Error: no opacities to dump. '
c
      last = lnblnk( cf_d )
c
      if ( last .le. 0 ) stop
     $     ' STOP -- DUMP_OPAL_OPAC: Error: blank dumpfile name. '
c
      if ( iu_out .gt. 0 .and. iu_out .le. 99 .and.
     $     iu_out .ne. 5 .and. iu_out .ne. 6 ) then
         iu = iu_out
      else
         iu = iulow
      endif
c
      call opneuf( iu, cf_d )
c
      write(iu) init_smo, low_CO_smo, interp_CO_smo,
     $     main_alt_change, iulow, khighz_in,
     $     ofebrack_in, level_err, nz, mx
c
      write(iu) indx,t6list,alr,n
      write(iu) alt,dfs,dfsr,b,m,mf,xa,alrf
      write(iu) flogtin,dfsx,oxf,cxf
      write(iu) xcdf,xodf,itime,cxdf
      write(iu) oxdf,q,h,xcd,xod,xc,xo
      write(iu) xcs,xos,cxd,oxd,cx,ox,zzz,xxh
      write(iu) xx,nc,no,zsto,zvint,dfsz,zacc
      write(iu) zlow,zmiddle,zhigh,zlo_ex,zhi_ex, numz
c
      do kz = 1, numz
         do kr = 1, nr
            do kt = 1, nt
               write(iu) ( ( ( co(ix,ic,io,kt,kr,kz), ix = 1, mx ),
     $              ic = 1, mc ), io = 1, mo )
            enddo
         enddo
      enddo
c
      write(iu) xhi_in, xcno_use,
     $     xhi_use, xxx_cno, xxx_hi,
     $     nx_hi, ireq_hi, khighx, kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
c
      write(iu) xiz_mix,fninz_mix,
     $     bracketife_mix,bracketofe_opalmixes,
     $     xofe_opalmixes,xiz_opalmixes,
     $     fninz_opalmixes,
     $     cel_opalmixes,cfile_opalmixes
c
      write(iu) bracketofe_opalGS98,
     $     xofe_opalGS98,xiz_opalGS98,
     $     fninz_opalGS98,atwt_opalGS98,
     $     cfile_opalGS98
c
      write(iu) len_def_CNO_ext,
     $     cdef_CNO_ext
c
      write(iu) fcno_mul, fninz_cno,
     $     xiz_cno, d_fninz_user,
     $     fcno_fac, fninz_heavy, xiz_heavy, d_fninz_u_heavy,
     $     s_ninzai_mix, ds_ninzai_u, fn_o_over_cno, fninz_co_mix
c
      write(iu) nta, ntax0,
     $     ntax03, sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
c
      write(iu) zvalhi,nofz,mnofz,
     $     zval,zalval,zavail,iadd_zavail
c
      write(iu) itimeco,mxzero,mx03,kope,igznotgx
c
      write(iu) NTEMP,NSM,nrlow,nrhigh,RLE,t6arr
c
      write(iu) cxfil,czfil, copdir
c
      write(iu) cfile_opal_used
c
      write(iu) kavail_alex, kuse_alex, kdo_alex, iualex
c							 ! NOT itoh_replace_max
      write(iu) kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next
c
      write(iu) need_alex_dir, cfile_alex
c
      write(iu) need_cond_dir, cfile_cond
c
      if ( kavail_alex .gt. 1 ) then
c
         write(iu) nr_ferg, nt_ferg, nz_ferg, nx_ferg,
     $        ntype_ferg, ntyp1_ferg, zdel_ferg, xdel_ferg
c
         do kx = 1, nx_ferg
            do kz = 1, nz_ferg
               write(iu) ( ( flk_ferg(kr,kt,kz,kx),
     $              kr = 1, nr_ferg ), kt = 1, nt_ferg )
            enddo
         enddo
c
         write(iu) zlog_ferg, xlog_ferg, dzinvlog_ferg, dzinv_ferg,
     $        dxinvlog_ferg, dxinv_ferg, t6log_ferg, rlog_ferg,
     $        dt6inv_ferg, drinv_ferg, modt_ferg, modz0_ferg, ntuferg
c
         write(iu) z_ferg, x_ferg, iacc_ferg, igot_t_ferg, igot_r_ferg,
     $        itype_ferg, lsep_ferg, lext_ferg, ltype_ferg,
     $        itype_def_ferg, ione_ferg, lz_ferg, lx_ferg,
     $        cz_ferg, cx_ferg,
     $        ctype_ferg, csub_ferg, csep_ferg, cext_ferg
c
         write(iu) ofein_ferg, i_ofe_ferg, i_ofe0_ferg
c
         write(iu) zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $        zlp2_ferg, xp2_ferg,
     $        i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
c
         write(iu) slt_max_ferg, sltswlo_ferg_def,
     $        sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $        sltswmid_ferg, dltsw2inv_ferg
c
      else if ( kavail_alex .gt. 0 ) then
c
         write(iu) zlog_alex, xlog_alex, dzinvlog_alex, dxinvlog_alex
c
         do kx = 1, nx_alex
            do kz = 1, nz_alex + max( 0 , 2 - kx )
               write(iu) ( ( flk_alex(kr,kt,kz,kx),
     $              kr = nrlo_alex, nr_alex ), kt = 1, nt_alex )
            enddo
         enddo
c
         write(iu) fltswlo_alex_def, fltswhi_alex_def,
     $        flrhoswlo_alex_def, flrhoswhi_alex_def,
     $        fltswlo_r_alex_def, fltswhi_r_alex_def, fltswlo_alex,
     $        fltswhi_alex, fltswmid_alex, dltsw2inv_alex,
     $        sltswhi_alex, flrhoswlo_alex, flrhoswhi_alex,
     $        flrhoswmid_alex, dlrhosw2inv_alex, fltswlo_r_alex,
     $        fltswhi_r_alex, fltswmid_r_alex, dltsw2inv_r_alex,
     $        isw_rho_alex
c
      endif
c
      if ( kavail_cond .gt. 1 ) then
c
         write(iu) flkc_pot
c
         write(iu) AT_pot, AR_pot, AZ_pot, sigconlog_pot, kZ_pot
c
         write(iu) zkpot, zlg_pot_p, i1pot_p,
     $        i4pot_p, j1pot_p, j4pot_p, i1pot, i2pot, i3pot, i4pot,
     $        j1pot, j2pot, j3pot, j4pot, k1pot, k2pot, k3pot, k4pot
c
      else if ( kavail_cond .gt. 0 ) then
c
         write(iu) flkc_hl
c
         write(iu) flrolo_hl, flrohi_hl,
     $     fltlo_hl, flthi_hl,
     $     flRlo_hl, flRhi_hl,
     $     itlo_hl, ithi_hl,
     $     irhi_hl, itlo_ok_hl, celkc_hl
c
      endif
c
      close(iu)
c
      return
      end
c
c******************************************************************************
c
      subroutine read_opal_dump( iu_in, cf_d )
c     ========================================
c
      character*(*) cf_d
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/c_opal_ctrl_smooth/ init_smo, low_CO_smo, interp_CO_smo
      save /c_opal_ctrl_smooth/
c
      common /alt_change_opal_z/ main_alt_change, iulow, khighz_in,
     $     ofebrack_in
      save /alt_change_opal_z/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mo_m2=mo-2 )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c
      character*80 cdef_CNO_ext(n_cnobeg:n_totmix)
      common /ext_CNO_opal_z/ len_def_CNO_ext(n_cnobeg:n_totmix),
     $     cdef_CNO_ext
      save /ext_CNO_opal_z/
c
      common /cno_delta_opal_z/ fcno_mul(4), fninz_cno(nel_zmix,5),
     $     xiz_cno(nel_zmix,5), d_fninz_user(nel_zmix),
     $     fcno_fac(0:3,4), fninz_heavy, xiz_heavy, d_fninz_u_heavy,
     $     s_ninzai_mix, ds_ninzai_u, fn_o_over_cno, fninz_co_mix
      save /cno_delta_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      parameter ( zdel=0.001, xdel=0.03, xdelmin=0.001 )
c
      parameter ( mz=8, mz_m1=mz-1, mz_m2=mz-2, mzhi=11, mzal=13,
     $     nzm=mzal+1, nadd_zavail=nzm-mz )
c
      common/zinter_opal_z/ zvalhi(mzhi),nofz(mzhi,5,mo),mnofz(mx),
     $     zval(mz),zalval(mzal),zavail(nzm),iadd_zavail(nadd_zavail)
      save /zinter_opal_z/
c
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c
      common/alink_opal_z/ NTEMP,NSM,nrlow,nrhigh,RLE,t6arr(100),
     $     coff(100,nrm)
      save /alink_opal_z/
c
      character*4 cxfil(5),czfil(mz)
      common/czinte_opal_z/ cxfil,czfil
      save /czinte_opal_z/
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c
      parameter ( nr_ferg=19, nt_ferg=85, nz_ferg=16, nx_ferg=10,
     $     nxm1_ferg=nx_ferg-1, nxm2_ferg=nx_ferg-2, n2_ferg=nz_ferg-3,
     $     ntype_ferg=12, ntyp1_ferg=ntype_ferg+1, nzp1_ferg=nz_ferg+1,
     $     nr_alex=25, nt_alex=23, nz_alex=11, nx_alex=6,
     $     nzp1_alex=nz_alex+1, nrm1_alex=nr_alex-1, nrlo_alex=-7,
     $     nxm1_alex=nx_alex-1, nxm2_alex=nx_alex-2, zex_alex=0.05,
     $     ntm1_alex=nt_alex-1, nrlop1_alex=nrlo_alex+1, dt_alex=0.05,
     $     dro_alex=0.25, zdel_alex=0.001, xdelmin_alex = 0.00001,
     $     xdel_alex=0.03, droinv_alex=4.0, dtinv_alex=20.0,
     $     zdel_ferg=2.e-6, z0_ferg=small_1m6*zdel_ferg,
     $     xdel_ferg=0.03 )
c
      common /mat_alex_ferg/ flk_ferg(nr_ferg,nt_ferg,nz_ferg,nx_ferg)
      save /mat_alex_ferg/
      dimension flk_alex(nrlo_alex:nr_alex,nt_alex,nzp1_alex,nx_alex)
      equivalence (flk_alex(nrlo_alex,1,1,1),flk_ferg(1,1,1,1))
c
      common /opac_alex/ zlog_alex(nzp1_alex),xlog_alex(nx_alex),
     $     dzinvlog_alex(nzp1_alex),dxinvlog_alex(nx_alex)
      save /opac_alex/
c
      common /opac_ferg/ zlog_ferg(nzp1_ferg), xlog_ferg(nx_ferg),
     $     dzinvlog_ferg(nz_ferg), dzinv_ferg(nz_ferg),
     $     dxinvlog_ferg(nx_ferg), dxinv_ferg(nx_ferg),
     $     t6log_ferg(nt_ferg), rlog_ferg(nr_ferg),
     $     dt6inv_ferg(nt_ferg), drinv_ferg(nr_ferg),
     $     modt_ferg, modz0_ferg, ntuferg
      save /opac_ferg/
c
      character*5 cz_ferg(nz_ferg), cx_ferg(nx_ferg)
      character*80 ctype_ferg(ntyp1_ferg), csub_ferg(ntyp1_ferg),
     $     csep_ferg, cext_ferg
      common /c_ini_ferg/ z_ferg(nz_ferg), x_ferg(nx_ferg), iacc_ferg,
     $     igot_t_ferg, igot_r_ferg, itype_ferg, lsep_ferg, lext_ferg,
     $     ltype_ferg(ntyp1_ferg), itype_def_ferg(ntyp1_ferg),
     $     ione_ferg(ntyp1_ferg), lz_ferg(nz_ferg), lx_ferg(nx_ferg),
     $     cz_ferg, cx_ferg, ctype_ferg, csub_ferg,
     $     csep_ferg, cext_ferg
      save /c_ini_ferg/
c
      common /c_ofe_in_ferg/ ofein_ferg, i_ofe_ferg, i_ofe0_ferg
      save /c_ofe_in_ferg/
c
      common /c_prev_ferg/ zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $     zlp2_ferg, xp2_ferg, i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
      save /c_prev_ferg/
c
      common /c_tsw_ferg/ slt_max_ferg, sltswlo_ferg_def,
     $     sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $     sltswmid_ferg, dltsw2inv_ferg
      save /c_tsw_ferg/
c
      character*255 cfile_alex
      common /c_filename_alex/ need_alex_dir, cfile_alex
      save /c_filename_alex/
c
      common /c_got_alex/ kavail_alex, kuse_alex, kdo_alex, iualex
      save /c_got_alex/
c
      common /c_trho_sw_alex/ fltswlo_alex_def, fltswhi_alex_def,
     $     flrhoswlo_alex_def, flrhoswhi_alex_def, fltswlo_r_alex_def,
     $     fltswhi_r_alex_def, fltswlo_alex, fltswhi_alex,
     $     fltswmid_alex, dltsw2inv_alex, sltswhi_alex, flrhoswlo_alex,
     $     flrhoswhi_alex, flrhoswmid_alex, dlrhosw2inv_alex,
     $     fltswlo_r_alex, fltswhi_r_alex, fltswmid_r_alex,
     $     dltsw2inv_r_alex, sltswlo_alex, isw_rho_alex
      save /c_trho_sw_alex/
c
      parameter ( nT_KcPot=19, nR_KcPot=64, nZ_KcPot=15 )
c
      parameter ( ntlokc=37, ntlokcm1=ntlokc-1, nthikc=90-ntlokcm1,
     $     nrlokc=-23, nrlokcm1=nrlokc-1, nrhikc=24-nrlokcm1, nkc=3,
     $     nthikcm1=nthikc-1, nrhikcm1=nrhikc-1, nkcp1=nkc+1 )
      parameter ( dlt_kc=.1, dlr_kc=.25, dltinv_kc=10., dlrinv_kc=4. )
c
      character*2 celkc_hl(nkc)
      common /c_flkcond_hlpot/ flkc_pot(nT_KcPot,nR_KcPot,nZ_KcPot),
     $     AT_pot(nT_KcPot), AR_pot(nR_KcPot), AZ_pot(nZ_KcPot),
     $     sigconlog_pot, itlo_hl(nrhikc,nkc), ithi_hl(nrhikc,nkc),
     $     irhi_hl(nkc), itlo_ok_hl(nrhikc,nkc),
     $     irjump_hl(nkc), celkc_hl
      save /c_flkcond_hlpot/
c
      dimension flkc_hl(nthikc,nrhikc,nkc),
     $     flrolo_hl(nkc), flrohi_hl(nkc),
     $     fltlo_hl(nkc), flthi_hl(nkc),
     $     flRlo_hl(nkc), flRhi_hl(nkc), kZ_pot(nZ_KcPot)
      equivalence (flkc_pot(1,1,1),flkc_hl(1,1,1)),
     $     (AR_pot(1),flrolo_hl(1)), (AR_pot(nkcp1),flrohi_hl(1)),
     $     (AT_pot(1),fltlo_hl(1)), (AT_pot(nkcp1),flthi_hl(1)),
     $     (AZ_pot(1),flRlo_hl(1)), (AZ_pot(nkcp1),flRhi_hl(1)),
     $     (itlo_hl(1,1),kZ_pot(1))
c
      common /c_got_cond/ kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next, itoh_replace_max(0:2)
      save /c_got_cond/
c
      common /c_pot_indices/ zkpot(0:3,0:3), zlg_pot_p, i1pot_p,
     $     i4pot_p, j1pot_p, j4pot_p, i1pot, i2pot, i3pot, i4pot,
     $     j1pot, j2pot, j3pot, j4pot, k1pot, k2pot, k3pot, k4pot
      save /c_pot_indices/
c
      parameter ( ndef_cond = 3 )
c
      character*255 cfile_cond
      character*80 cdef_cond(ndef_cond)
      common /c_filename_cond/ need_cond_dir, cfile_cond, cdef_cond
      save /c_filename_cond/
c___
      logical lxst
c===
      last = lnblnk( cf_d )
c
      if ( last .le. 0 ) stop
     $     ' STOP -- READ_OPAL_DUMP: Error: blank dumpfile name. '
c
      call inqfil( cf_d, lxst )
c
      if ( .not. lxst ) then
         write(6,'(" READ_OPAL_DUMP: dumpfile not found:"/" ",a)')
     $        cf_d(:last)
         stop ' STOP -- READ_OPAL_DUMP: Error: dumpfile not found. '
      endif
c
      if ( iu_in .gt. 0 .and. iu_in .le. 99 .and.
     $     iu_in .ne. 5 .and. iu_in .ne. 6 ) then
         iu = iu_in
      else
         iu = iulow
      endif
c
      call opoluf( iu, cf_d )
c
      read(iu) init_smo, low_CO_smo, interp_CO_smo,
     $     main_alt_change, iulow, khighz_in,
     $     ofebrack_in, level_err, nz_sto, mx_sto
c
      if ( nz .ne. nz_sto ) then
         close(iu)
         write(6,20) nz, nz_sto, cf_d(:last)
 20      format(/' READ_OPAL_DUMP: nz=',i3,' .ne. nz=',i3,
     $        ' in dumpfile:'/' ',a)
         stop ' STOP -- READ_OPAL_DUMP: Error: bad parameter nz. '
      else if ( mx .ne. mx_sto ) then
         close(iu)
         write(6,30) mx, mx_sto, cf_d(:last)
 30      format(/' READ_OPAL_DUMP: mx=',i3,' .ne. mx=',i3,
     $        ' in dumpfile:'/' ',a)
         stop ' STOP -- READ_OPAL_DUMP: Error: bad parameter mx. '
      endif
c
      read(iu) indx,t6list,alr,n
      read(iu) alt,dfs,dfsr,b,m,mf,xa,alrf
      read(iu) flogtin,dfsx,oxf,cxf
      read(iu) xcdf,xodf,itime,cxdf
      read(iu) oxdf,q,h,xcd,xod,xc,xo
      read(iu) xcs,xos,cxd,oxd,cx,ox,zzz,xxh
      read(iu) xx,nc,no,zsto,zvint,dfsz,zacc
      read(iu) zlow,zmiddle,zhigh,zlo_ex,zhi_ex, numz
c
      do kz = 1, numz
         do kr = 1, nr
            do kt = 1, nt
               read(iu) ( ( ( co(ix,ic,io,kt,kr,kz), ix = 1, mx ),
     $              ic = 1, mc ), io = 1, mo )
            enddo
         enddo
      enddo
c
      read(iu) xhi_in, xcno_use,
     $     xhi_use, xxx_cno, xxx_hi,
     $     nx_hi, ireq_hi, khighx, kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
c
      read(iu) xiz_mix,fninz_mix,
     $     bracketife_mix,bracketofe_opalmixes,
     $     xofe_opalmixes,xiz_opalmixes,
     $     fninz_opalmixes,
     $     cel_opalmixes,cfile_opalmixes
c
      read(iu) bracketofe_opalGS98,
     $     xofe_opalGS98,xiz_opalGS98,
     $     fninz_opalGS98,atwt_opalGS98,
     $     cfile_opalGS98
c
      read(iu) len_def_CNO_ext,
     $     cdef_CNO_ext
c
      read(iu) fcno_mul, fninz_cno,
     $     xiz_cno, d_fninz_user,
     $     fcno_fac, fninz_heavy, xiz_heavy, d_fninz_u_heavy,
     $     s_ninzai_mix, ds_ninzai_u, fn_o_over_cno, fninz_co_mix
c
      read(iu) nta, ntax0,
     $     ntax03, sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
c
      read(iu) zvalhi,nofz,mnofz,
     $     zval,zalval,zavail,iadd_zavail
c
      read(iu) itimeco,mxzero,mx03,kope,igznotgx
c
      read(iu) NTEMP,NSM,nrlow,nrhigh,RLE,t6arr
c
      read(iu) cxfil,czfil, copdir
c
      read(iu) cfile_opal_used
c
      read(iu) kavail_alex, kuse_alex, kdo_alex, iualex
c							 ! NOT itoh_replace_max
      read(iu) kavail_cond, kuse_cond, kdo_cond, iucond,
     $     ifix_h_cond, itoh_gap, itoh_replace,
     $     ifix_h_cond_next, itoh_gap_next
c
      read(iu) need_alex_dir, cfile_alex
c
      read(iu) need_cond_dir, cfile_cond
c
      if ( kavail_alex .gt. 1 ) then
c
         call init_ferg_indices
c
         read(iu) kr_ferg, kt_ferg, kz_ferg, kx_ferg,
     $        ktype_ferg, ktyp1_ferg, tzdel_ferg, txdel_ferg
c
         if ( kr_ferg .ne. nr_ferg .or. kt_ferg .ne. nt_ferg .or.
     $        kz_ferg .ne. nz_ferg .or. kx_ferg .ne. nx_ferg .or.
     $        ktype_ferg .gt. ntype_ferg .or.
     $        abs( tzdel_ferg - zdel_ferg ) .gt. small_1m6 .or.
     $        abs( txdel_ferg - xdel_ferg ) .gt. small_1m6 ) then
            close(iu)
            write(6,50) kr_ferg, kt_ferg, kz_ferg, kx_ferg, ktype_ferg,
     $           tzdel_ferg, txdel_ferg, nr_ferg, nt_ferg, nz_ferg,
     $           nx_ferg, ntype_ferg, zdel_ferg, xdel_ferg, cf_d(:last)
 50         format(/' READ_OPAL_DUMP: nr_ferg=',i3,', nt_ferg=',i3,
     $           ', nz_ferg=',i3,', nx_ferg=',i3,','/
     $           '       ntype_ferg=',i3,', zdel_ferg=',f10.7,
     $           ', xdel_ferg=',f10.7,'  DIFFER from'/
     $           '  STORED VALUES: nr_ferg=',i3,', nt_ferg=',i3,
     $           ', nz_ferg=',i3,', nx_ferg=',i3,','/
     $           '       ntype_ferg=',i3,', zdel_ferg=',f10.7,
     $           ', xdel_ferg=',f10.7,'  in dumpfile:'/' ',a)
            stop ' STOP -- READ_OPAL_DUMP Error: bad KAPPA_ferg size. '
         endif
c
         do kx = 1, nx_ferg
            do kz = 1, nz_ferg
               read(iu) ( ( flk_ferg(kr,kt,kz,kx),
     $              kr = 1, nr_ferg ), kt = 1, nt_ferg )
            enddo
         enddo
c
         read(iu) zlog_ferg, xlog_ferg, dzinvlog_ferg, dzinv_ferg,
     $        dxinvlog_ferg, dxinv_ferg, t6log_ferg, rlog_ferg,
     $        dt6inv_ferg, drinv_ferg, modt_ferg, modz0_ferg, ntuferg
c
         read(iu) z_ferg, x_ferg, iacc_ferg, igot_t_ferg, igot_r_ferg,
     $        itype_ferg, lsep_ferg, lext_ferg,
     $        ( ltype_ferg(i), i = 1, ktype_ferg ),
     $        ltype_ferg(ntyp1_ferg), itype_def_ferg(1),
     $        itype_def_ferg(2), ( itype_def_ferg(i),
     $        i = ntyp1_ferg - ktyp1_ferg + 3, ntyp1_ferg ),
     $        ( ione_ferg(i), i = 1, ktype_ferg ),
     $        ione_ferg(ntyp1_ferg), lz_ferg, lx_ferg,
     $        cz_ferg, cx_ferg,
     $        ( ctype_ferg(i), i = 1, ktype_ferg ),
     $        ctype_ferg(ntyp1_ferg),
     $        ( csub_ferg(i), i = 1, ktype_ferg ),
     $        csub_ferg(ntyp1_ferg), csep_ferg, cext_ferg
c
c	! if old default-ferg-type-input-order array size was smaller, ensure
c						! that array has no duplicates
         if ( ktyp1_ferg .lt. ntyp1_ferg ) then
            ihi = ntyp1_ferg - ktyp1_ferg + 2
            do i = 3, ihi
               ieq = 0
               do j = 1, ntyp1_ferg
                  if ( ( j .lt. i .or. j .gt. ihi ) .and.
     $                 itype_def_ferg(j) .eq. itype_def_ferg(i) )
     $                 ieq = 1
               enddo
               if ( ieq .ne. 0 ) then
                  itype_def_ferg(i) = ntyp1_ferg + 1
                  do while ( ieq .ne. 0 )
                     itype_def_ferg(i) = itype_def_ferg(i) - 1
                     if ( itype_def_ferg(i) .le. 0 ) stop
     $                    ' STOP -- READ_OPAL_DUMP Error: bad itype?! '
                     ieq = 0
                     do j = 1, ntyp1_ferg
                        if ( ( j .lt. i .or. j .gt. ihi ) .and.
     $                       itype_def_ferg(j) .eq. itype_def_ferg(i) )
     $                       ieq = 1
                     enddo
                  enddo
               endif
            enddo
         endif
c
         read(iu) ofein_ferg, i_ofe_ferg, i_ofe0_ferg
c
         read(iu) zlogp_ferg, xp_ferg, zlp1_ferg, xp1_ferg,
     $        zlp2_ferg, xp2_ferg,
     $        i1p_ferg, i4p_ferg, j1p_ferg, j4p_ferg
c
         read(iu) slt_max_ferg, sltswlo_ferg_def,
     $        sltswhi_ferg_def, sltswlo_ferg, sltswhi_ferg,
     $        sltswmid_ferg, dltsw2inv_ferg
c
      else if ( kavail_alex .gt. 0 ) then
c
         read(iu) zlog_alex, xlog_alex, dzinvlog_alex, dxinvlog_alex
c
         do kx = 1, nx_alex
            do kz = 1, nz_alex + max( 0 , 2 - kx )
               read(iu) ( ( flk_alex(kr,kt,kz,kx),
     $              kr = nrlo_alex, nr_alex ), kt = 1, nt_alex )
            enddo
         enddo
c
         read(iu) fltswlo_alex_def, fltswhi_alex_def,
     $        flrhoswlo_alex_def, flrhoswhi_alex_def,
     $        fltswlo_r_alex_def, fltswhi_r_alex_def, fltswlo_alex,
     $        fltswhi_alex, fltswmid_alex, dltsw2inv_alex,
     $        sltswhi_alex, flrhoswlo_alex, flrhoswhi_alex,
     $        flrhoswmid_alex, dlrhosw2inv_alex, fltswlo_r_alex,
     $        fltswhi_r_alex, fltswmid_r_alex, dltsw2inv_r_alex,
     $        isw_rho_alex
c
         sltswlo_alex = fltswlo_alex - 6.
c
      endif
c
      if ( kavail_cond .gt. 1 ) then
c
         read(iu) flkc_pot
c
         read(iu) AT_pot, AR_pot, AZ_pot, sigconlog_pot, kZ_pot
c
         read(iu) zkpot, zlg_pot_p, i1pot_p,
     $        i4pot_p, j1pot_p, j4pot_p, i1pot, i2pot, i3pot, i4pot,
     $        j1pot, j2pot, j3pot, j4pot, k1pot, k2pot, k3pot, k4pot
c
      else if ( kavail_cond .gt. 0 ) then
c
         read(iu) flkc_hl
c
         read(iu) flrolo_hl, flrohi_hl,
     $     fltlo_hl, flthi_hl,
     $     flRlo_hl, flRhi_hl,
     $     itlo_hl, ithi_hl,
     $     irhi_hl, itlo_ok_hl, celkc_hl
c
         call find_rjump_hl_cond
c
      endif
c
      close(iu)
c
      return
      end
c
c******************************************************************************
c
      subroutine read_kz(kz,z,kallrd,khighz,iu_lo,ofebrack)
c     =====================================================
c
c NOTE: kallrd is ignored (it is present only for backward compatibility).
c
c PARAMETERS to control the offset from zero for the logarithmic interpolation:
c  zdel = 0.001 (must be the same value as in OPAL)
c  xdel = 0.03 (must be the same value as in OPAL)
c  xdelgn93 = 0.005 = xdel value for use with X-interpolation in 'GN93hz' file
c                      among X-tables 0.0, 0.1, 0.2 (to get X = 0.03 mix); note
c                      that 0.005 works slightly better for this than 0.03
c
      parameter ( small_1m6=1.e-6, small_1m8=1.e-8, small_m1m8=-1.e-8 )
c
      parameter ( small_1m5=1.e-5, small_3m7=3.e-7 )
c
      parameter ( zdel=0.001, xdel=0.03, xdelgn93=0.005 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mo_m2=mo-2 )
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
      parameter ( nrdel=nrb-1, ntdel=ntb-1 )
      parameter ( nrm_m2=nrm-2, nt_m1=nt-1, nre_p1=nre+1, nre_m1=nre-1 )
      parameter ( badlogkval=1.e+35, badlogklim=20. )
      parameter ( ks81=ntm-3, ks83=ks81+1, ks60=ks81-21, ks61=ks60+1,
     $     alrlo=-8.0, flogtlo=3.75, flogt60=6.0, flogt81=8.1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      common /c_level_list_opal_z/ iu_list, level_list, list_mult,
     $     list_gn(-n_zmixes:n_totmix)
      save /c_level_list_opal_z/
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c
      character*80 cdef_CNO_ext(n_cnobeg:n_totmix)
      common /ext_CNO_opal_z/ len_def_CNO_ext(n_cnobeg:n_totmix),
     $     cdef_CNO_ext
      save /ext_CNO_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
c COMMON /c_opal_ctrl_smooth/ : flags to control the opacity smoothing:
c
      common/c_opal_ctrl_smooth/ init_smo, low_CO_smo, interp_CO_smo
      save /c_opal_ctrl_smooth/
c
      common/alink_opal_z/ NTEMP,NSM,nrlow,nrhigh,RLE,t6arr(100),
     $     coff(100,nrm)
      save /alink_opal_z/
c
      COMMON/CST_OPAL_Z/ NRL,RLS,nset,tmax
      save /CST_OPAL_Z/
c
      common/e_opal_z/ opact,dopact,dopacr,dopactd,fedge,ftredge,fzedge
      save /e_opal_z/
c
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c
      parameter ( mz=8, mz_m1=mz-1, mz_m2=mz-2, mzhi=11, mzal=13,
     $     nzm=mzal+1, nadd_zavail=nzm-mz )
c
      common/zinter_opal_z/ zvalhi(mzhi),nofz(mzhi,5,mo),mnofz(mx),
     $     zval(mz),zalval(mzal),zavail(nzm),iadd_zavail(nadd_zavail)
      save /zinter_opal_z/
c
      common /alt_change_opal_z/ main_alt_change, iulow, khighz_in,
     $     ofebrack_in
      save /alt_change_opal_z/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c
      character*4 cxfil(5),czfil(mz)
      common/czinte_opal_z/ cxfil,czfil
      save /czinte_opal_z/
c
c  The following common block /opdir/ contains a character file giving the
c  directory where the Gz???.x?? files are to be found.
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c___
c
c  copfil = the full opacity filename (including directory), changed as needed
c  copalt = temporary (needed only for error message: new form of opacity file)
c
      character*255 copfil,copalt
c
c  cin / ch  holds a line read in from the opacity file (with opacity values)
c
      character*137 cin
c-noneed;      character*1 ch(137)
c-noneed;      equivalence (ch(1),cin)
c
c  lxst is a logical variable used to check whether the new form Gz???.x?? of
c        opacity files exists, rather than the old form Gx??z*
c
      logical lxst
c
c LOCAL ARRAYS:
c  cofzat(4,nrm) = temporary storage for input opacity values as a function of
c                   R, at up to four Z-table values (these will be interpolated
c                   in Z if necessary, prior to being stored)
c  xzalat(3) = X-table value(s) for relevant mix(es) in 'GN93hz'.  For m = mx03
c               (X=0.03), xzalat = { 0.0 , 0.1 , 0.2 }; else, xzalat(1) = xa(m)
c  kzvalnof(4) = Z-indexes in number-of-mixes table nofz for each of the (up
c                 to 4) Z-tables being interpolated among (in Gz???.x?? files)
c  nofmjz(4) = temporary number-of-C-mixes for each of the (up to 4) Z-tables
c               being interpolated among: for a given X-table index m and
c               O-table index j,  nofmjz(i) = nofz(kzvalnof(i),mnofz(m),j)
c  iz_get(4) = flag, for each of the (up to 4) Z-tables being interpolated
c               among, to tell the function mixfind whether to read in or check
c               the Z-composition; 1 = read it in, -1 = check it, 0 = neither
c               (i.e., not presently positioned at the beginning of the file).
c               The function mixfind resets this flag to zero.
c  iz_rew(4) = flag, for each of the (up to 4) Z-tables being interpolated
c               among, to tell the function mixfind whether to rewind the file
c               being read in before looking for the next (Z,X,C,O) mix;
c               1 = rewind, 0 = do not rewind.  The function mixfind resets
c               this flag to zero, unless the mix being looked for is not found
c               or does not follow consecutively after the previous mix, in
c               which case it is reset to unity ("rewind next time")
c  iz_tab(4) = mix-table index in Gz???.x?? opacity files, for each of the (up
c               to 4) Z-tables being interpolated among; it is set by mixfind
c  ico_got(mc,mo) = matrix of flags telling whether the corresponding (C,O)
c                    opacity table was read in/interpolated successfully (for
c                    the current X-table index m); 1 = succeeded, 0 = failed.
c                    In a few cases, near the line C+O = 1-X-Z, a mix may not
c                    be present at enough Z-table values to allow it to be
c                    interpolated in Z, in which case this flag will be set to
c                    zero; rather than extrapolating such a mix in Z, it is
c                    subsequently interpolated in C or O (note that it will
c                    lie near a mix on the line C+O = 1-X-Z, so there will not
c                    be much of an interpolation).
c  nthx0(0:nrm) = temporary version of ntax0(0:nrm), used for "hz"-files
c  nthx03(0:nrm) = temporary version of ntax03(0:nrm), used for "hz"-files
c
      dimension cofzat(4,nrm),xzalat(3),kzvalnof(4),nofmjz(4),
     $     iz_get(4),iz_rew(4),iz_tab(4),ico_got(mc,mo),
     $     nthx0(0:nrm),nthx03(0:nrm)
c
c LOCAL ARRAYS: cofzhi(ntm,nrm,6) is used for temporary storage for opacities
c  from 'GN93hz' or from file with non-zero [O/Fe]; xhi_look(6) and zhi_look(6)
c  are used to hold the 'GN93hz' X-values, including those not found in the
c  'Gz???.x??' files, and the corresponding Z-values to be looked for.
c
      dimension cofzhi(ntm,nrm,6), xhi_look(6), zhi_look(6)
c
c Storage for the compression-flags and opacity file names that are opened,
c and the line numbers in these opacity files:
c
      dimension igzip_sto(0:3)
      character*255 cop_sto(0:3)
      dimension line(0:3)
c
c-debug-chk[
c-debug-chk;      dimension chk_max(20),chk_min(20),chk_sum(20),chk_ssq(20),
c-debug-chk;     $     n_chk(20)
c-debug-chk;c
c-debug-chk;      common /readkz_opal_debug_chk/ iout_debug_chk_ofe
c-debug-chk]
c-test-xdel[                              ! test xdel values in GN93hz X-interp
c-test-xdel;      parameter ( n_xdtst=4 )
c-test-xdel;      dimension cof_tst(ntm,nrm,n_xdtst),dif_tst(4,n_xdtst),
c-test-xdel;     $     xdel_tst(n_xdtst)
c-test-xdel;      data xdel_tst/0.03,0.01,0.001,0.0001/
c-test-xdel]
c-debug-chk[
c-debug-chk;      data iout_debug_chk_ofe / 99999 /
c-debug-chk]
c
c===
      if ( kz .le. 0 .or. kz .gt. nz ) stop
     $     ' STOP -- READCO Error: Z-index out of range: cannot be! '
c
c Check input unit number iu_lo, and use it to set iulow.
c
      if ( iu_lo .ge. 7 .and. iu_lo .le. 96 ) then
         iulow = iu_lo
      else if ( iu_lo .ge. 0 .and. level_err .gt. 0 ) then
         stop ' STOP -- READCO Error: bad iulow value. '
      endif
c
      if ( level_err .gt. 99 .and. kallrd .le. 0 ) write(6,
     $     '(" ***WARNING: READCO: kallrd < 1 ignored.")')
c
c Check some parameter values, and do some initializations.
c
      call opalinit( khighz, ofebrack, z, kz, 0 )
c
      khighz_in = khighz
      ofebrack_in = ofebrack
c							     ! Z out of range?
      if ( z .ge. zval(mz) + small_1m6 .or. z .le. small_m1m8 ) then
         write(6,8703) z
 8703    format(' '/' READCO Error: Z=',f10.7,
     $        ': Z > 0.1 (or < 0) not allowed!!!')
         stop ' STOP -- READCO Error: bad Z value: out of range. '
      endif
c						      ! accuracy to match table
      zacc(kz) = min( small_1m6 , max( small_1m8 , 0.01 * z ) )
c
c  Find the correct Z value(s) to be read in, in the range 0.0 to 0.1
c
      kzbelo = mz
      do while( kzbelo .gt. 1 .and. z .le. zval(kzbelo) - small_1m6 )
         kzbelo = kzbelo-1
      enddo
c
c  If Z is very close to a tabulated Z-value, don't need to interpolate,
c  unless Z --> 0 ; note that nmorez ("number of extra Z-values") indicates
c  the presence and type of interpolation:
c    nmorez = 0 if the tabulated Z-value can be used (with no Z-interpolation),
c    nmorez = 2 if quadratic interpolation among 3 Z-values will be performed,
c    nmorez = 3 if overlapping quadratices will be used among 4 Z-values.
c
      if ( abs( zval(kzbelo) - z ) .le. zacc(kz) ) then
         zat = zval(kzbelo)
         kzlow = kzbelo
         k1zfac = kzbelo
         nmorez = 0
c		     ! else: closest 3 or 4 table Z-values to interpolate among
      else
         zat = z
         kzlow = min( max( 1 , kzbelo - 1 ) , mz_m2 )
         k1zfac = min( kzbelo , mz_m1 )
         nmorez = min( kzbelo + 2 , mz ) - kzlow
      endif
c
      kzlow_m1 = kzlow - 1
      k2zfac = min( k1zfac + 1 , kzlow + nmorez )
c							! find position in nofz
      do i = kzlow, kzlow + nmorez
         kzvalnof(i-kzlow_m1) = int( 100. * zval(i) + 1.01 )
      enddo
      kznof = min( int( 100. * z + 1.0001 ) , mzhi )
      lznof = max( int( 100. * z + 0.9999 ) , 1 )
c
c  NOTE that if Z > 0 and the GS98 mix is being used (khighz < 0), then both
c  the GN93hz and GS98hz files will always be needed; if [O/Fe] is non-zero
c  and khighz < -1, then a GS98 [O/Fe]-file is also needed.  OTHERWISE:
c  Check if need C+O=0.0 "hz" tables: if [O/Fe] = 0 or Z = 0, there will be no
c  need to interpolate in [O/Fe] (set khizat = 1), and if there is no need to
c  interpolate in [O/Fe], then for Z equal to a Z-table value or .01 < Z < .02
c  the "hz" tables will yield no improvement and are not used (set khizat = 0).
c
c							     ! this is in [0:5]
      khighz_index = min( mod( abs(khighz), 10 ) , n_zmixes )
c
c	! parameter mx=5 ALWAYS; then  khighz_cno = 1 if CNO-interp needed,
c				!   = 2 if user-file needed, = 3 if both needed
      if ( mx .eq. 5 ) then
         khighz_cno = min( abs(khighz) / 10 , 3 )
         if ( khighz_cno .ge. 2 .and. kavail_user .le. 0 )
     $        khighz_cno = khighz_cno - 2
         if ( mod( khighz_cno, 2 ) .eq. 1 .and. kavail_cno .le. 0 )
     $        khighz_cno = khighz_cno - 1
      else
         khighz_cno = 0
      endif
c
c if Z = 0.0 or khighz = 0, then  khizat = klozat = 0
c else if khighz > 0, then  khizat = k[O/Fe] (or 1 if [O/Fe]=0.0),  klozat = 0
c else if khighz < 0, then  khizat = 1,  klozat = k[O/Fe] (or 1 if [O/Fe]=0.0)
c
      if ( z .lt. zacc(kz) ) then
         klozat = 0
         khizat = 0
      else if ( khighz .lt. 0 ) then
         khizat = 1
         if ( ofebrack .eq. 0. ) then
            klozat = 1
         else
            klozat = khighz_index
         endif
      else
         klozat = 0
         khizat = khighz_index
         if ( ofebrack .eq. 0. ) khizat = min(khizat,1)
         if ( khizat .eq. 1 .and. ( ( zval(k1zfac) .ge. 0.01 .and.
     $        zval(k2zfac) .le. 0.02 ) .or. nmorez .eq. 0 ) )
     $        khizat = 0
      endif
c			! these initializations just prevent compiler warnings:
      kzalow = 1
      facxhz = 1.0
      fofe = 1.0
      omfofe = 0.0
c
c  If needed, get position in C+O=0.0 "hz"-tables, which have more Z values.
c  Note that nzalmo (for GN93hz) is analogous to nmorez (for Gz???.x?? files)
c
      if ( khizat .gt. 0 ) then
         kzalbe = mzal
         do while( kzalbe .gt. 1 .and.
     $        z .le. zalval(kzalbe) - small_1m6 )
            kzalbe = kzalbe - 1
         enddo
         if ( abs( zalval(kzalbe) - z ) .le. zacc(kz) ) then
            zat = zalval(kzalbe)
            kzalow = kzalbe
            nzalmo = 0
         else
            kzalow = max( 1 , kzalbe - 1 )
            nzalmo = min( kzalbe + 2 , mzal ) - kzalow
         endif
      endif
c			       ! set the directory-part of the opacity filename
      if ( kope .eq. 0 ) then
         copfil = ' '
      else
         copfil = copdir(:kope)
      endif
c				! store present m-value (should be unnecessary)
      mstore = m
c		     ! (for usual X-values): khighx(kz) = 1 (set high-X deltas)
      khighx(kz) = 0
      if ( khighz_index .ne. 0 .and. mx .eq. 5 .and.
     $     max( abs( xhi_in(1) - xa(1) ) , abs( 0.03 - xa(2) ) ,
     $     abs( xhi_in(2) - xa(3) ) , abs( xhi_in(4) - xa(4) ) ,
     $     abs( xhi_in(6) - xa(5) ) ) .le. small_1m6 ) khighx(kz) = 1
c
c			   ! get shifted z-value Z+zdel, for log interpolation
      zzz(kz) = zat + zdel
      zvint(kz) = log10( zzz(kz) )
      zsto(kz) = zat
c			 ! should read in Z-composition from first opacity file
      igetzxi = 1
c
c {--------------------------------------- Begin loop over m values (X-tables):
c
      do m = 1, mx
c					     ! later Z-compositions: just check
         if ( m .ne. 1 ) igetzxi = -1
c					     ! get C,O compositions for this m
         xhemx = 1. - xa(m) - zat
         do i = 1, mc
            nc = i
            no = i
            xc(i) = xcs(i)
            xo(i) = xos(i)
c						  ! allow some round-off error:
            if ( xcs(i) .ge. xhemx - small_1m6 ) then
               xc(i) = xhemx
               xo(i) = xhemx
               goto 10
            endif
         enddo
 10      continue
c				! check that number of C-mixes is correct
c
         if ( nc .ne. nofz(kznof,mnofz(m),1) .and.
     $        nc .ne. nofz(lznof,mnofz(m),1) ) then
            write(6,8704) m,lznof,kznof,nofz(lznof,mnofz(m),1),
     $           nofz(kznof,mnofz(m),1),nc
 8704       format(' '/' READCO Error: (m=',i1,
     $           ') bad nc value: nofz({',i2,' or',i3,'},m,1)={',
     $           i1,' or',i2,'} .ne. nc=',i1)
            stop ' STOP -- READCO Error: bad nc value: cannot be. '
         endif
c
c........ initialization: for itime, oxf...oxdf, n(m,*,kz)  (xx was done above)
c
c........ this is the first time through this m and kz.  Calculate the decadic
c         log of the perimeter points shifted by Z+zdel (to avoid divergence 
c         at origin: zdel=0.001); m refers to xa(m), the hydrogen table value.
c
         do i = 1, nc
c						    ! O,C values for each X,C,O
            oxf(m,i,kz) = log10( zzz(kz) + xo(i) )
            cxf(m,i,kz) = log10( zzz(kz) + xc(i) )
            xcdf(m,i,kz) = xo(no) - xo(i)
            xodf(m,i,kz) = xc(nc) - xc(i)
            cxdf(m,i,kz) = log10( zzz(kz) + xcdf(m,i,kz) )
            oxdf(m,i,kz) = log10( zzz(kz) + xodf(m,i,kz) )
c							   ! present C,O values
            ox(i) = oxf(m,i,kz)
            cx(i) = cxf(m,i,kz)
            xcd(i) = xcdf(m,i,kz)
            xod(i) = xodf(m,i,kz)
            cxd(i) = cxdf(m,i,kz)
            oxd(i) = oxdf(m,i,kz)
c
         enddo
c				! set and check number-of-mixes table n(m,j,kz)
         do j = 1, nc - 1
            do i = 1, nc
               if ( xcd(j) .ge. xc(i) ) then
                  n(m,j,kz) = i + 1
                  if ( xcd(j) .lt. xc(i) + small_1m6 ) n(m,j,kz) = i
               endif
            enddo
            if ( n(m,1,kz) .ne. nc .or.
     $           ( n(m,j,kz) .ne. nofz(kznof,mnofz(m),j)
     $           .and. n(m,j,kz) .ne. nofz(lznof,mnofz(m),j) ) ) then
               write(6,8705) m,nc,j,n(m,j,kz),lznof,kznof,j,
     $              nofz(lznof,mnofz(m),j),nofz(kznof,mnofz(m),j)
 8705          format(' '/' READCO Error: (m=',i1,',nc=',i1,
     $              ') bad value of n(m,',i1,')=',i1,
     $              ' .ne. nofz({',i2,' or',i3,'},m,',i1,')={',
     $              i1,' or',i2,'}')
               stop ' STOP -- READCO Error: bad n(m,j): cannot be. '
            endif
         enddo
c		      ! nc-th elements sometimes needed, though this may not be
         do j = nc, mc
            n(m,j,kz) = 0
         enddo
c		   		   ! initialize boundaries at low-X,low-R,low-T
         if ( kz .eq. 1 ) then
            if ( m .eq. mxzero ) then
               do i = nrb, nre
                  ntax0(i) = ntb
               enddo
            else if ( m .eq. mx03 ) then
               do i = nrb, nre
                  ntax03(i) = ntb
               enddo
            endif
         endif
c			! end of initializations for this m value
c
c If it will increase accuracy, first read in C+O=0.0 "hz" table(s) from GN93hz
c  (and possibly from a file with [O/Fe] > 0), for the present m value.
c
c Note that 'Gz???.x??' files contain Z=0.05, while 'GN93hz' contains Z=0.04
c  and 0.06; thus, for Z near 0.05, the 'Gz???.x??' opacities are more accurate
c  than the 'GN93hz' opacities.  For .04 < Z < .05 or for .05 < Z < .06 , the
c  'GN93hz' opacities are read in, but their effects are reduced (according to
c  how close Z is to 0.05) by setting the factor  facxhz  to a value less than
c  unity.
c
c Note that X=0.03 (m=2) requires X-interpolation in the 'GN93hz' tables: this
c  is only done if interpolating in [O/Fe] as well, and the effect of the m=2
c  'GN93hz' opacities is nullified by setting  facxhz  to zero.  (The 'GN93hz'
c  opacity shifts for m=2 may be obtained later by interpolating opacity shifts
c  among m=1,3,4 if this is possible.)
c					     ! read 'GN93hz' only if necessary:
c
         if ( khizat .gt. 0 .and. ( m .ne. mx03 .or.
     $        khizat .gt. 1 .or. klozat .gt. 0 ) ) then
c
c				   ! for m = mx03 (X=.03), X-interpolation in
c				   ! GN93hz is less accurate than the Gz???.x??
c				   ! opacities: the GN93hz opacities are needed
c				    ! only for [O/Fe] shifts, so set facxhz=0.
            if ( m .eq. mx03 ) then
               facxhz = 0.
               nxdo = 3
               xzalat(1) = 0.
               xzalat(2) = 0.1
               xzalat(3) = 0.2
               do i = nrb, nre
                  nthx03(i) = ntb
               enddo
c				! Else (for m not mx03): do need GN93hz shifts:
            else
               facxhz = 1.
c			       ! but near Z = 0.05, the Gz???.x?? opacities are
c						        ! better: reduce facxhz
               if ( zat .gt. 0.04 .and. zat .lt. 0.06 )
     $              facxhz = 1. - 100. * min( zat - 0.04 , 0.06 - zat )
               nxdo = 1
               xzalat(1) = xa(m)
               if ( m .eq. mxzero ) then
                  do i = nrb, nre
                     nthx0(i) = ntb
                  enddo
               endif
            endif
c			      ! number of "excess" X-tables (for interpolation)
            nmorex = nxdo - 1
c			      ! indices for GN93hz Z-tabulation array zalval
            j1 = kzalow
            j2 = j1 + min( 1 , nzalmo )
            j3 = j1 + min( 2 , nzalmo )
            j4 = j1 + min( 3 , nzalmo )
c
            is = 0
            isx = 0
            iu = iulow
c			! start with always-needed GN93hz file
            iofe = 1
c			!    for {klozat,khizat} = {0,1} {0,4} {1,1} {1,4}
c			! co(m,mc,mo,{T},{R},kz) = GN93  GN93  GN93  GN93
c			! co(m,mc,mo-1, ...    ) = none  W95   GS98  GS98
c			! co(m,mc,mo-2, ...    ) = none  none  none  GS98_W95
            moat = mo
c						! read C+O=0.0 "hz"-table(s):
            do while ( iofe .ne. 0 )
c							! get filename
               if ( iofe .gt. 0 ) then
                  copfil(kope+1:) = cfile_opalmixes(iofe)
                  if ( iofe .eq. 1 ) then
                     cfile_opal_used(1) = cfile_opalmixes(iofe)
                     cfile_opal_used(4) = cfile_opalmixes(iofe)
                  else
                     cfile_opal_used(n_zmixes) = cfile_opalmixes(iofe)
                  endif
               else
                  if ( iofe .eq. -1 ) then
                     cfile_opal_used(1) = cfile_opalGS98(1)
                     copfil(kope+1:) = cfile_opalGS98(1)
                  else
                     call chk_ofe_alt_file( -iofe )
                     copfil(kope+1:) = cfile_opal_used(n_zmixes)
                     if ( cfile_opalGS98(-iofe) .ne. ' ' )
     $                    cfile_opalGS98(-iofe) =
     $                                       cfile_opal_used(n_zmixes)
                  endif
               endif
c
               if ( list_gn(iofe) .gt. 0 ) then
                  if ( iu_list .eq. iu ) then
                     write(6,4) iu_list
 4                   format(/' ***OPAL WARNING: READCO:',
     $                    ' bad LIST_IU =',i3,
     $                    ', reset to 6 (standard output)'/)
                     iu_list = 6
                  endif
                  write(iu_list,2) iofe, copfil(:lnblnk(copfil))
 2                format(' ***OPAL/Type_1_(',i2,'): ',a)
                  list_gn(iofe) = 0
               endif
c								! open file
               call open_chk_zip( iu, copfil, igzip,
     $              'READCO Error: hz-file (C+O=0.0) not found.' )
c
               line(1) = 0
c				     ! dummy table-number; initial cofzhi index
               itab_dum = 0
               kzsto = 0
c					! get Z-composition(s) from "hz"-files,
               if ( m .eq. 1 ) then
                  igetzxi = 1
c			       ! or just check them if they were already gotten
               else
                  igetzxi = -1
               endif
c					! loop over X values, if more than one
               do kx = 1, nxdo
c					! increment cofzhi mix-store-position
                  kzsto = kzsto + 1
c						  ! loop over file Z values
                  do iz = kzalow, kzalow + nzalmo
c						  ! kat is Z-index in cofzhi
                     kat = kzsto + iz - kzalow
c					       ! find mix; stop if not found
                     i_rewind = 0
                     ifound = mixfind(iu,iofe,igetzxi,i_rewind,
     $                    itab_dum,line(1),
     $                    zalval(iz),xzalat(kx),0.0,0.0)
                     if ( ifound .eq. 0 ) then
                        write(6,1791) zalval(iz),xzalat(kx),0.0,0.0,
     $                          copfil(:lnblnk(copfil))
 1791                   format(' '/' READCO: Error finding mix Z=',
     $                       f6.4,' X=',f6.4,' C=',f6.4,' O=',f6.4,
     $                       '  from file:'/' ',a/' ')
                        stop ' STOP -- READCO: error reading hz-mix. '
                     endif
c								! check [O/Fe]
                     if ( kx .eq. 1 .and. iz .eq. kzalow ) then
                        if ( iofe .eq. 1 ) then
c						! (this cannot happen)
                           if ( abs( bracketofe_opalmixes(1) ) .gt.
     $                          small_3m7 ) write(6,1783) 'GN93hz',
     $                          bracketofe_opalmixes(1)
 1783                      format(/' READCO: Error: ',a,
     $                          ' file has [O/Fe] =',f12.7/20x,
     $                          '(its [O/Fe] should be 0.0)',5x,
     $                          'THIS SHOULD NOT HAPPEN!'/)
                           if ( abs( bracketofe_opalmixes(1) ) .gt.
     $                          small_3m7 ) stop
     $                          ' STOP -- READCO: non-0 [O/Fe]_GN93hz '
c						! is file [O/Fe] too small?
                        else if ( iofe .gt. 0 ) then
                           if ( abs(bracketofe_opalmixes(iofe)) .lt.
     $                          max(0.1*abs(ofebrack),0.001) ) then
                              write(6,2631) ofebrack,
     $                             bracketofe_opalmixes(iofe),
     $                             iofe, copfil(:lnblnk(copfil))
 2631                         format(' '/' READCO: [O/Fe] =',f10.6,
     $                             ': cannot get from [O/Fe] =',
     $                             f10.6,' in file',i3,':'/' ',a/' ')
                              stop ' STOP -- READCO: bad [O/Fe] file. '
                           endif
                        else if ( iofe .eq. -1 ) then
c						! (this cannot happen)
                           if ( abs( bracketofe_opalGS98(1) ) .gt.
     $                          small_3m7 ) write(6,1783)
     $                          'alternate-solar (e.g., GS98hz)',
     $                          bracketofe_opalGS98(1)
                           if ( abs( bracketofe_opalGS98(1) ) .gt.
     $                          small_3m7 ) stop
     $                          ' STOP -- READCO: non-0 [O/Fe]_GS98hz '
c						! is file [O/Fe] too small?
                        else 
                           if ( abs(bracketofe_opalGS98(-iofe)) .lt.
     $                          max(0.1*abs(ofebrack),0.001) ) then
                              write(6,2631) ofebrack,
     $                             bracketofe_opalGS98(-iofe),
     $                             iofe, copfil(:lnblnk(copfil))
                              stop ' STOP -- READCO: bad [O/Fe] file. '
                           endif
                        endif
                     endif
c				  ! loop over logT values, to read in opacities
                     do k = 1, ntm
c					      ! read logT,{logKappa(R) @ all R}
                        line(1) = line(1) + 1
                        read(iu,7300) cin
 7300                   format(a137)
                        read(cin,7140) flt, (cofzhi(k,il,kat),il=1,nrm)
 7140                   format(f4.2,19f7.3)
c								   ! bad logT ?
                        if ( abs(flogtin(k)-flt) .gt. small_1m5 ) then
                           write(6,1734) flt, flogtin(k),
     $                          copfil(:lnblnk(copfil)), line(1),
     $                          cin(:max(1,lnblnk(cin))),
     $                          zalval(iz),xzalat(kx),0.0,0.0
 1734                      format(/' Error reading logT value =',f10.6,
     $                          ' should be',f10.6,
     $                          ' from opacity file:'/' ',a/
     $                          ' at line',i8,', which contained:'/
     $                          ' "',a,'"'/
     $                          ' while reading mix [Z=',f6.4,
     $                          ' X=',f6.4,' C=',f6.4,' O=',f6.4,']'/
     $                          ' *****THIS SHOULD NOT HAPPEN.'/)
                           stop ' STOP -- READCO: bad logT value. '
                        endif
c							      ! logKappa(R) is:
                        do il = nrm, 1, -1
c								       ! absent
                           if ( cin(7*il-2:7*il+4) .eq.
     $                          '       ' ) then
                              if ( k .le. max(nta(il),nta(0)) ) stop
     $                             ' STOP -- READCO: bad upper edge. '
c
c						  ! get value, for smoothing
c
                              cofzhi(k,il,kat) = 2.*cofzhi(k-1,il,kat)
     $                             - cofzhi(k-2,il,kat)
c							     ! should be absent
                           else if ( k .gt. nta(il) .and.
     $                             il .ge. nrb .and. il .le. nre ) then
                              stop ' STOP -- READCO: bad upper edge. '
c									! 9.999
                           else if ( cofzhi(k,il,kat) .gt. 9. ) then
                              if ( ( m .ne. mxzero .and. m .ne. mx03 )
     $                             .or. il .ge. nrm_m2 .or.
     $                             flt .ge. 4.2 ) then
                                 stop ' STOP -- READCO: bad low edge. '
                              else if ( m .eq. mxzero ) then
                                 nthx0(il) = max( nthx0(il) , k + 1 )
                              else if ( m .eq. mx03 ) then
                                 nthx03(il) = max( nthx03(il) , k + 1 )
                              endif
c						  ! get value, for smoothing
c
                              cofzhi(k,il,kat) = 2.*cofzhi(k,il+1,kat)
     $                             - cofzhi(k,il+2,kat)
                           endif
c						! end of check-logKappa(R) loop
                        enddo
c						! end of T-loop
                     enddo
c						! end of Z-loop
                  enddo
c						! interpolate in Z, if needed
                  if ( nzalmo .gt. 0 ) then
                     kdelzhi = kzalow - kzsto
                     do k = 1, ntm
                        do il = 1, nrm
                           cofzhi(k,il,kzsto) = qzinter(is,1,zat,
     $                          nzalmo,cofzhi(k,il,j1-kdelzhi),
     $                          cofzhi(k,il,j2-kdelzhi),
     $                          cofzhi(k,il,j3-kdelzhi),
     $                          cofzhi(k,il,j4-kdelzhi),
     $                          zalval(j1),zalval(j2),zalval(j3),
     $                          zalval(j4),zdel)
                           is = 1
                        enddo
                     enddo
                  endif
c						! end of X-loop
               enddo
c			 ! close hz-file (have all necessary opacities from it)
c
               call close_chk_zip( iu, copfil, igzip )
c
c						! interpolate in X if necessary
               if ( nxdo .eq. 3 ) then
                  do k = 1,ntm
                     do il = 1,nrm
c-test-xdel[
c-test-xdel;                        do ij = 1,n_xdtst
c-test-xdel;                           cof_tst(k,il,ij) = qzinter(isx,ij+2,
c-test-xdel;     $                          xa(m),nmorex,cofzhi(k,il,1),
c-test-xdel;     $                          cofzhi(k,il,2),cofzhi(k,il,3),
c-test-xdel;     $                          0.0,xzalat(1),xzalat(2),xzalat(3),
c-test-xdel;     $                          0.0,xdel_tst(ij))
c-test-xdel;                        enddo
c-test-xdel]
                        cofzhi(k,il,1) = qzinter(isx,2,xa(m),nmorex,
     $                       cofzhi(k,il,1),cofzhi(k,il,2),
     $                       cofzhi(k,il,3),0.0,xzalat(1),xzalat(2),
     $                       xzalat(3),0.0,xdelgn93)
                        isx = 1
                     enddo
                  enddo
               endif
c-test-xdel[
c-test-xdel;               do ij = 1,n_xdtst
c-test-xdel;                  do il = 1,nrm
c-test-xdel;                     do k = 1,ntm
c-test-xdel;                        coff(k,il) = cof_tst(k,il,ij)
c-test-xdel;                     enddo
c-test-xdel;                  enddo
c-test-xdel;                  if ( init_smo .gt. 0 ) then
c-test-xdel;                     tmax = 10.
c-test-xdel;                     nset = ks81
c-test-xdel;                     NSM = 1
c-test-xdel;                     RLS = alrf(1)
c-test-xdel;                     RLE = alrf(nrm)
c-test-xdel;                     nrhigh = int(dfsr(nr)*(RLE-RLS)+1.00001)
c-test-xdel;                     nrlow = 1
c-test-xdel;                     call opaltab
c-test-xdel;                  endif
c-test-xdel;                  do il = 1,nrm
c-test-xdel;                     do k = 1,ntm
c-test-xdel;                        cof_tst(k,il,ij) = coff(k,il)
c-test-xdel;                     enddo
c-test-xdel;                  enddo
c-test-xdel;               enddo
c-test-xdel]
c			    ! transfer opacities from Z,X-interpolation storage
               do il = 1,nrm
                  do k = 1,ntm
                     coff(k,il) = cofzhi(k,il,1)
                  enddo
               enddo
c						! revise high-T,RHO extension
               call revise_hitr_for_initsmooth
c					 ! smooth hz-opacities, if init_smo > 0
               if ( init_smo .gt. 0 ) then
                  tmax = 10.
                  nset = ks81
                  NSM = 1
c					 ! note: MUST have all dfsr(i) = 1./0.5
                  RLS = alrf(1)
                  RLE = alrf(nrm)
                  nrhigh = int( dfsr(nr) * ( RLE - RLS ) + 1.00001 )
                  nrlow = 1
c				  ! fit and smooth OPAL kappas, up to T6 = tmax
                  call opaltab
c				! end of hz-opacity smoothing
               endif
c					    ! set any missing values to 1.0E+35
               do il = nre, nrb, -1
c-not-these[						 ! except at high-T,RHO
c-not-these;                  if ( nta(il) .lt. ntm ) then
c-not-these;                     do k = nta(il) + 1, ntm
c-not-these;                        coff(k,il) = badlogkval
c-not-these;                     enddo
c-not-these;                  endif
c-not-these]
                  if ( m .eq. mxzero ) then
                     if ( il .lt. nre )
     $                    nthx0(il) = max( nthx0(il) , nthx0(il+1) )
                     if ( nthx0(il) .gt. ntb ) then
                        do k = ntb, nthx0(il) - 1
                           coff(k,il) = badlogkval
                        enddo
                     endif
                  else if ( m .eq. mx03 ) then
                     if ( il .lt. nre )
     $                    nthx03(il) = max( nthx03(il) , nthx03(il+1) )
                     if ( nthx03(il) .gt. ntb ) then
                        do k = ntb, nthx03(il) - 1
                           coff(k,il) = badlogkval
                        enddo
                     endif
                  endif
               enddo
c				! store present hz-opacity set in free space
               do il = 1,nr
                  jl = il+nrdel
                  do k = 1,nt
                     co(m,mc,moat,k,il,kz) = coff(k+ntdel,jl)
                  enddo
               enddo
c				! position to store next hz-opacity set
               moat = moat - 1
c						! get next iofe value, if any
               if ( iofe .eq. -klozat ) then
                  iofe = 0
               else if ( iofe .eq. -1 ) then
                  iofe = -klozat
               else if ( iofe .eq. khizat ) then
                  iofe = max( -klozat , -1 )
               else
                  iofe = khizat
               endif
c				! end of loop reading in C+O=0.0 table(s)
            enddo
c			    ! only check (don't store) Z-composition, in future
            igetzxi = -1
c				! end of obtaining C+O=0.0 'GN93hz'-table(s)
         endif
c
c Read in opacities from 'Gz???.x??' files, interpolating in Z if necessary,
c  for files with the present m value (i.e., with the present X value xa(m)).
c UPDATE: 25 May 1999: look for newer format  Gz???.x??  first; if this is not
c  found, then look for older format  Gx??z*  instead.
c
c			! turn off all "mix-acquired" flags
         do i = 1, mc
            do j = 1, mo
               ico_got(i,j) = 0
            enddo
         enddo
c					! get filename(s) and open file(s):
         do iu = iulow, iulow + nmorez
c
            if ( igznotgx .ge. 0 ) then
               copfil(kope+1:kope+1) = 'G'
               copfil(kope+2:kope+5) = czfil(kzlow+iu-iulow)
               if ( copfil(kope+4:kope+4) .eq. ' ' )
     $              copfil(kope+4:kope+4) = '0'
               if ( copfil(kope+5:kope+5) .eq. ' ' )
     $              copfil(kope+5:kope+5) = '0'
               copfil(kope+6:) = cxfil(m)
               copfil(kope+6:kope+6) = '.'
            else
               copfil(kope+1:kope+4) = cxfil(m)
               copfil(kope+5:) = czfil(kzlow+iu-iulow)
            endif
c
            if ( igznotgx .eq. 0 ) then
               call inqfil(copfil,lxst)
               if ( .not. lxst )
     $              call inqfil( copfil(1:kope+9) // '.gz' , lxst )
               if ( .not. lxst )
     $              call inqfil( copfil(1:kope+9) // '.Z' , lxst )
               if ( lxst ) then
                  igznotgx = 1
               else
                  copalt = copfil
                  copfil(kope+1:kope+4) = cxfil(m)
                  copfil(kope+5:) = czfil(kzlow+iu-iulow)
                  call inqfil(copfil,lxst)
                  if ( .not. lxst ) then
                     k_e = kope + 8
                     if ( copfil(k_e:k_e) .eq. ' ' ) k_e = k_e - 1
                     if ( copfil(k_e:k_e) .eq. ' ' ) k_e = k_e - 1
                     call inqfil( copfil(1:k_e) // '.gz' , lxst )
                     if ( .not. lxst )
     $                    call inqfil( copfil(1:k_e) // '.Z' , lxst )
                  endif
                  if ( lxst ) then
                     igznotgx = -1
                  else
                     write(6,7399) copalt(:lnblnk(copalt)),
     $                    copfil(:lnblnk(copfil))
 7399                format(' '/' STOP -- READCO: neither Gz???.x??',
     $                    ' nor Gx??z* OPAL opacity files found:'/
     $                    ' ',a/' ',a)
                     stop ' STOP -- READCO: Gz???.x?? file not found. '
                  endif
               endif
            endif
c
            cop_sto(iu-iulow) = copfil
c
            if ( level_list .gt. 0 ) then
               if ( iu_list .eq. iu ) then
                  write(6,4) iu_list
                  iu_list = 6
               endif
               if ( list_mult .gt. 0 ) then
                  if ( list_mult .eq. 1 ) then
                     write(iu_list,1) copfil(:lnblnk(copfil)), '  ...'
 1                   format(' ***OPAL/Type_2: ',a,a)
                  else
                     write(iu_list,1) copfil(:lnblnk(copfil))
                  endif
                  list_mult = list_mult - 1
               endif
            endif
c
            call open_chk_zip( iu, copfil, igzip_sto(iu-iulow),
     $           'READCO Error: Gz???.x?? opacity file not found.' )
            line(iu-iulow) = 0
c
         enddo
c				! read in Z-composition only for 1st file
         do i = 1, nmorez + 1
            iz_get(i) = -1
            iz_rew(i) = 0
            iz_tab(i) = 0
         enddo
         iz_get(1) = igetzxi
c				! Z-position indices j1 to j4, for array zval
         j1 = kzlow
         j2 = j1 + min( 1 , nmorez )
         j3 = j1 + min( 2 , nmorez )
         j4 = j1 + min( 3 , nmorez )
         is = 0
c				! loop over dXo (excess oxygen) index j
         do j = 1, no - 1
c				! number of dXc values at Z for this dXo
            ihi = n(m,j,kz)
            do jz = 1, nmorez + 1
               nofmjz(jz) = nofz(kzvalnof(jz),mnofz(m),j)
            enddo
c				! loop over dXc (excess carbon) index i
            do i = 1, ihi
c				! number of "extra" Z-values, for interpolation
               nmorat = nmorez
c				! note: the case i=1,j=1 will ALWAYS have is1=1
               is1 = 1
c					     ! loop over Z values: find tables
               do iz = kzlow, kzlow + nmorez
c					     ! other Z-index jz starts at 1
                  jz = iz - kzlow_m1
                  iu = iulow + iz - kzlow
c					  ! if a mix (with higher Z-value) is
c					  ! missing a needed C-O table, then
c					  ! rewinding may work (if needed table
c					  ! duplicates an earlier C-O table)
c
                  if ( i .gt. nofmjz(jz) ) iz_rew(jz) = 1
                  cget = xcs(i)
                  if ( i .eq. ihi )
     $                 cget = min( cget , 1.-xa(m)-xos(j)-zval(iz) )
                  ifound = mixfind(iu,1,iz_get(jz),iz_rew(jz),
     $                 iz_tab(jz),line(iu-iulow),
     $                 zval(iz),xa(m),cget,xos(j))
c							      ! if table is not
c					      ! present in this file, it cannot
c					      ! be used in the Z-interpolation,
                  if ( ifound .eq. 0 ) then
c							     ! so reduce nmorat
                     nmorat = min( iz - kzlow - 1 , nmorat )
c							     ! (cannot happen):
                     if ( nmorat .lt. 0 ) then
                        write(6,1791) zval(iz),xa(m),cget,xos(j),
     $                       cop_sto(iu
     $                       -iulow)(:lnblnk(cop_sto(iu-iulow)))
                        stop ' STOP -- READCO: error reading mix. '
c-debug-chk[
c-debug-chk;                     else
c-debug-chk;                        write(6,1878) m,z,i,j,jz,nofmjz(jz),
c-debug-chk;     $                       iz_rew(jz),nmorat
c-debug-chk; 1878                   format(' m=',i1,' Z=',f9.7,
c-debug-chk;     $                       ' cannot find i=',i1,' j=',i1,
c-debug-chk;     $                       ' Z(jz=',i1,'): Nofmjz=',i1,
c-debug-chk;     $                       ' irew=',i2,' nmorat=',i2)
c-debug-chk]
                     endif
                     is1 = 2
                     is = 0
                  endif
               enddo
c		       ! if needed table exists at enough Z-values, read it in:
c
               if ( nmorat .eq. nmorez .or. nmorat .eq. 2 ) then
c								 ! loop over T:
                  do k = 1, ntm
c					        ! loop over Z values: read line
                     do iz = kzlow, kzlow + nmorat
                        jz = iz - kzlow_m1
                        iu = iulow + iz - kzlow
c					   ! read logT, & logKappa(R) for all R
                        line(iu-iulow) = line(iu-iulow) + 1
                        read(iu,7300) cin
                        read(cin,7140) flt,(cofzat(jz,il),il=1,nrm)
c								   ! bad logT ?
                        if ( abs(flogtin(k)-flt) .gt. small_1m5 ) then
                           write(6,1734) flt, flogtin(k), cop_sto(iu
     $                          -iulow)(:lnblnk(cop_sto(iu-iulow))),
     $                          line(iu-iulow),
     $                          cin(:max(1,lnblnk(cin))),
     $                          zval(iz),xa(m),cget,xos(j)
                           stop ' STOP -- READCO: bad logT value. '
                        endif
c								  ! store logT
                        if ( k .ge. ntb ) alt(k-ntdel) = flt - 6.
                        flogtin(k) = flt
c							      ! logKappa(R) is:
                        do il = nrm, 1, -1
c								       ! absent
                           if ( cin(7*il-2:7*il+4) .eq.
     $                          '       ' ) then
                              if ( k .le. max(nta(il),nta(0)) ) stop
     $                             ' STOP -- READCO: bad upper edge. '
                              cofzat(1,il) = badlogkval
c								 ! or should be
                           else if ( k .gt. nta(il) .and.
     $                             il .ge. nrb .and. il .le. nre ) then
                              stop ' STOP -- READCO: bad upper edge. '
c								     ! or 9.999
                           else if ( cofzat(jz,il) .gt. 9. ) then
                              if ( ( m .ne. mxzero .and. m .ne. mx03 )
     $                             .or. il .ge. nrm_m2 .or.
     $                             flt .ge. 4.2 ) then
                                 stop ' STOP -- READCO: bad low edge. '
c
c							    ! set lower bounds:
                              else if ( m .eq. mxzero ) then
                                 ntax0(il) = max( ntax0(il) , k + 1 )
                              else if ( m .eq. mx03 ) then
                                 ntax03(il) = max( ntax03(il) , k + 1 )
                              endif
c							       ! for smoothing:
                              cofzat(jz,il) = 2.*cofzat(jz,il+1)
     $                             -cofzat(jz,il+2)
                           endif
c						! end of check-logKappa(R) loop
                        enddo
c					! end of Z-loop
                     enddo
c				  ! interpolate logKappa(R) in Z; store in COFF
                     do il = 1, nrm
c				    ! if opacity missing, extrapolate value for
c								    ! smoothing
                        if ( abs(cofzat(1,il)) .gt. badlogklim ) then
                           coff(k,il) = 2.*coff(k-1,il) - coff(k-2,il)
c
c						      ! else if table-Z is O.K.
                        else if ( nmorez .eq. 0 ) then
                           coff(k,il) = cofzat(1,il)
c							! else, Z-interpolation
                        else
                           coff(k,il) = qzinter(is,is1,zat,nmorat,
     $                          cofzat(j1-kzlow_m1,il),
     $                          cofzat(j2-kzlow_m1,il),
     $                          cofzat(j3-kzlow_m1,il),
     $                          cofzat(j4-kzlow_m1,il),zval(j1),
     $                          zval(j2),zval(j3),zval(j4),zdel)
                           is = 1
                        endif
                     enddo
c						! end of T-loop
                  enddo
c						  ! revise high-T,RHO extension
                  call revise_hitr_for_initsmooth
c					    ! smooth opacities, if init_smo > 0
                  if ( init_smo .gt. 0 ) then
                     tmax = 10.
                     nset = ks81
                     NSM = 1
c					 ! note: MUST have all dfsr(i) = 1./0.5
                     RLS = alrf(1)
                     RLE = alrf(nrm)
                     nrhigh = int( dfsr(nr) * ( RLE - RLS ) + 1.00001 )
                     nrlow = 1
c				  ! fit and smooth OPAL kappas, up to T6 = tmax
                     call opaltab
c				  ! end of opacity smoothing
                  endif
c				  ! store opacities
                  do il = 1, nr
                     jl = il + nrdel
                     do k = 1, nt
                        co(m,i,j,k,il,kz) = coff(k+ntdel,jl)
                     enddo
                  enddo
c				   ! set flag indicating this table was read in
                  ico_got(i,j) = 1
c				   ! end of reading in table
               endif
c			! end of loop over dXc (excess carbon) index
            enddo
c			! end of loop over dXo (excess oxygen) index
         enddo
c
c........ Read remaining diagonal tables (along line Y=0 in dXc,dXo plane)
c
         do jz = 1, nmorez + 1
            nofmjz(jz) = nofz(kzvalnof(jz),mnofz(m),1) - 1
            if ( nofmjz(jz) .lt. no - 1 ) iz_rew(jz) = 1
         enddo
c			! loop over dXc (excess carbon) inverted-index j; note
c			  ! that table being read in will be stored at i=(no-j)
         do j = 1, no - 1
c
            nmorat = nmorez
            is1 = 1
            nomj = no - j
c					     ! loop over Z values: find tables
            do iz = kzlow, kzlow + nmorat
               iu = iulow + iz - kzlow
               jz = iz - kzlow_m1
               oget = 1. - xa(m) - xcs(nomj) - zval(iz)
               ifound = mixfind(iu,1,iz_get(jz),iz_rew(jz),
     $              iz_tab(jz),line(iu-iulow),
     $              zval(iz),xa(m),xcs(nomj),oget)
               if ( ifound .eq. 0 ) then
                  nmorat = min( iz - kzlow - 1 , nmorat )
                  if ( nmorat .lt. 0 ) then
                     write(6,1791) zval(iz),xa(m),xcs(nomj),oget,
     $                    cop_sto(iu-iulow)(:lnblnk(cop_sto(iu-iulow)))
                     stop ' STOP -- READCO: error reading mix. '
c-debug-chk[
c-debug-chk;                  else
c-debug-chk;                     write(6,2878) m,z,j,mo,jz,nofmjz(jz),
c-debug-chk;     $                    iz_rew(jz),nmorat
c-debug-chk; 2878                format(' m=',i1,' Z=',f9.7,
c-debug-chk;     $                    ' cannot find i=',i1,' j=',i1,
c-debug-chk;     $                    ' Z(jz=',i1,'): Nofmjz=',i1,
c-debug-chk;     $                    ' irew=',i2,' nmorat=',i2)
c-debug-chk]
                  endif
                  is1 = 2
                  is = 0
               endif
            enddo
c		       ! if needed table exists at enough z-values, read it in:
c
            if ( nmorat .eq. nmorez .or. nmorat .eq. 2 ) then
c								 ! loop over T:
               do k = 1, ntm
c					        ! loop over Z values: read line
                  do iz = kzlow, kzlow + nmorat
                     jz = iz - kzlow_m1
                     iu = iulow + iz - kzlow
c					   ! read logT, & logKappa(R) for all R
                     line(iu-iulow) = line(iu-iulow) + 1
                     read(iu,7300) cin
                     read(cin,7140) flt,(cofzat(jz,il),il=1,nrm)
c								   ! bad logT ?
                     if ( abs(flogtin(k)-flt) .gt. small_1m5 ) then
                        write(6,1734) flt, flogtin(k), cop_sto(iu
     $                       -iulow)(:lnblnk(cop_sto(iu-iulow))),
     $                       line(iu-iulow), cin(:max(1,lnblnk(cin))),
     $                       zval(iz),xa(m),xcs(nomj),oget
                        stop ' STOP -- READCO: bad logT value. '
                     endif
c							      ! logKappa(R) is:
                     do il = nrm, 1, -1
c								       ! absent
                        if ( cin(7*il-2:7*il+4) .eq. '       ' ) then
                           if ( k .le. max(nta(il),nta(0)) ) stop
     $                          ' STOP -- READCO: bad upper edge. '
                           cofzat(1,il) = badlogkval
c								 ! or should be
                        else if ( k .gt. nta(il) .and.
     $                          il .ge. nrb .and. il .le. nre ) then
                           stop ' STOP -- READCO: bad upper edge. '
c								     ! or 9.999
                        else if ( cofzat(jz,il) .gt. 9. ) then
                           if ( ( m .ne. mxzero .and. m .ne. mx03 )
     $                          .or. il .ge. nrm_m2 .or.
     $                          flt .ge. 4.2 ) then
                              stop ' STOP -- READCO: bad low edge. '
                           else if ( m .eq. mxzero ) then
                              ntax0(il) = max( ntax0(il) , k + 1 )
                           else if ( m .eq. mx03 ) then
                              ntax03(il) = max( ntax03(il) , k + 1 )
                           endif
c								! for smoothing
                           cofzat(jz,il) = 2.*cofzat(jz,il+1)
     $                          - cofzat(jz,il+2)
                        endif
c						! end of check-logKappa(R) loop
                     enddo
c					! end of Z-loop
                  enddo
c				   ! interpolate in Z; store in COFF
                  do il = 1, nrm
                     if ( abs(cofzat(1,il)) .gt. badlogklim ) then
                        coff(k,il) = 2.*coff(k-1,il) - coff(k-2,il)
                     else if ( nmorez .eq. 0 ) then
                        coff(k,il) = cofzat(1,il)
                     else
                        coff(k,il) = qzinter(is,is1,zat,nmorat,
     $                       cofzat(j1-kzlow_m1,il),
     $                       cofzat(j2-kzlow_m1,il),
     $                       cofzat(j3-kzlow_m1,il),
     $                       cofzat(j4-kzlow_m1,il),zval(j1),
     $                       zval(j2),zval(j3),zval(j4),zdel)
                        is = 1
                     endif
                  enddo
c						! end of T-loop
               enddo
c						! revise high-T,RHO extension
               call revise_hitr_for_initsmooth
c					    ! smooth opacities, if init_smo > 0
               if ( init_smo .gt. 0 ) then
                  tmax = 10.
                  nset = ks81
                  NSM = 1
c					 ! note: MUST have all dfsr(i) = 1./0.5
                  RLS = alrf(1)
                  RLE = alrf(nrm)
                  nrhigh = int( dfsr(nr) * ( RLE - RLS ) + 1.00001 )
                  nrlow = 1
c				  ! fit and smooth OPAL kappas, up to T6 = tmax
                  call opaltab
c				  ! end of opacity smoothing
               endif
c				  ! store opacities
               do il = 1,nr
                  jl = il+nrdel
                  do k = 1,nt
                     co(m,nomj,mo,k,il,kz) = coff(k+ntdel,jl)
                  enddo
               enddo
c				   ! set flag indicating this table was read in
               ico_got(nomj,mo) = 1
c				    ! end of reading in table
            endif
c			! end of loop over dXc (excess carbon) inverted-index
         enddo
c					! close 'Gz???.x??' files
         do iu = iulow, iulow + nmorez
            call close_chk_zip( iu, cop_sto(iu-iulow),
     $           igzip_sto(iu-iulow) )
         enddo
c				    ! for X=0 or .03, ensure low-R,low-T corner
c				    !  has no steps in the wrong direction
         if ( m .eq. mxzero ) then
            do il = nre_m1, nrb, -1
               ntax0(il) = max( ntax0(il) , ntax0(il+1) )
            enddo
         else if ( m .eq. mx03 ) then
            do il = nre_m1,nrb,-1
               ntax03(il) = max( ntax03(il) , ntax03(il+1) )
            enddo
         endif
c			! Set missing opacity values in low-T,R,X corner (but
c			!  not in high-T,R corner) to badlogkval = 1.0E+35
         do il = 1, nr
            jl = il + nrdel
            if ( m .eq. mxzero ) then
               khi = ntax0(jl) - ntb
            else if ( m .eq. mx03 ) then
               khi = ntax03(jl) - ntb
            else
               khi = 0
            endif
            if ( khi .gt. 0 ) then
               do j = 1,mo
                  if ( j .lt. no ) then
                     ihi = n(m,j,kz)
                  else if ( j .eq. mo ) then
                     ihi = no - 1
                  else
                     ihi = 0
                  endif
                  if ( ihi .gt. 0 ) then
                     do k = 1, khi
                        do i = 1, ihi
                           co(m,i,j,k,il,kz) = badlogkval
                        enddo
                     enddo
                  endif
               enddo
            endif
c-not-these[
c-not-these;            if ( nta(jl) .lt. ntm ) then
c-not-these;               do j = 1, mo
c-not-these;                  if ( j .lt. no ) then
c-not-these;                     ihi = n(m,j,kz)
c-not-these;                  else if ( j .eq. mo ) then
c-not-these;                     ihi = no - 1
c-not-these;                  else
c-not-these;                     ihi = 0
c-not-these;                  endif
c-not-these;                  if ( ihi .gt. 0 ) then
c-not-these;                     do k = nta(jl) + 1 - ntdel, nt
c-not-these;                        do i = 1, ihi
c-not-these;                           co(m,i,j,k,il,kz) = badlogkval
c-not-these;                        enddo
c-not-these;                     enddo
c-not-these;                  endif
c-not-these;               enddo
c-not-these;            endif
c-not-these]
         enddo
c
c........ Interpolate any missing opacity tables in dXc or dXo; these will be
c          at or near the line Y=0, arising from the fact that files for higher
c          Z-values may not have had as many dXc or dXo tables in them as are
c          needed for the input (interpolated) Z-value.
c							  ! first, main tables:
         do j = 1, no - 1
            ihi = n(m,j,kz)
            do i = 1, ihi
c					      ! if flag indicates missing table
               if ( ico_got(i,j) .eq. 0 ) then
                  oat = xos(j)
                  cat = min( xcs(i) , 1. - xa(m) - zat - oat )
c-debug-chk[
c-debug-chk;                  write(6,1973) zat,m,i,j,ihi,cat,oat
c-debug-chk; 1973             format(' '/'     Z=',f9.7,' --- interpolate',
c-debug-chk;     $                 ' mix (m=',i1,',i=',i1,',j=',i1,
c-debug-chk;     $                 ') with ihi=',i1,' C=',f10.7,' O=',f10.7)
c-debug-chk;                  difmax = -9.999999
c-debug-chk;                  difmin = 9.999999
c-debug-chk;                  sumdif = 0.
c-debug-chk;                  sumsq = 0.
c-debug-chk;                  numsq = 0
c-debug-chk;                  diflmax = -9.999999
c-debug-chk;                  diflmin = 9.999999
c-debug-chk;                  sumldif = 0.
c-debug-chk;                  sumlsq = 0.
c-debug-chk]
c					   ! if C > or = O in missing table,
                  if ( cat .ge. oat ) then
c					   ! then the only C-value that can be
c					   ! missing is the next-to-highest one
c						       ! at ihi-1 = n(m,j,kz)-1
c
                     if ( ico_got(ihi,j) .le. 0 .and. i .ne. ihi )
     $                    write(6,1873) zat,m,ihi,j,ihi,
     $                    min(xcs(ihi),1.-xa(m)-zat-oat),oat
                     if ( i .ne. ihi-1 .or. i .lt. 3 )
     $                    write(6,1873) zat,m,i,j,ihi,
     $                    min(xcs(i),1.-xa(m)-zat-oat),oat
 1873                format(' '/'     Z=',f9.7,' ??? CANNOT miss',
     $                    ' mix (m=',i1,',i=',i1,',j=',i1,
     $                    ') with ihi=',i1,' C=',f10.7,' O=',f10.7)
                     if ( ico_got(ihi,j) .le. 0 .or.
     $                    i .lt. 3 .or. i .ne. ihi - 1 ) stop
     $                    ' STOP -- READCO: missing mix: CANNOT be. '
c
                     im2 = i - 2
                     im1 = i - 1
                     cxhi = log10( zzz(kz) + min( xcs(ihi) ,
     $                    1. - xa(m) - zat - oat ) )
c-debug-chk[
c-debug-chk;                     write(6,1974) i,j,'C',xcs(i),'C',cx(i),
c-debug-chk;     $                    im2,j,im1,j,ihi,j,'C',xcs(im2),xcs(im1),
c-debug-chk;     $                    min(xcs(ihi),1.-xa(m)-zat-oat),
c-debug-chk;     $                    'C',cx(im2),cx(im1),cxhi
c-debug-chk; 1974                format('      --- interpolate (',i1,',',i1,
c-debug-chk;     $                    ') in ',a1,'=',f10.6,' log',a1,'=',f10.6,
c-debug-chk;     $                    ' among (',i1,',',i1,') (',i1,',',i1,
c-debug-chk;     $                    ') (',i1,',',i1,'): ',a1,'=',3f10.6,
c-debug-chk;     $                    ' log',a1,'=',3f10.6)
c-debug-chk]
c				! interpolate in C to get missing table:
c
                     call quadsto( 1, cx(i), cx(im2), cx(im1), cxhi )
                     do il = 1, nr
                        do k = 1, nt
                           if ( abs( co(m,im1,j,k,il,kz) ) .lt.
     $                          badlogklim ) then
                              co(m,i,j,k,il,kz) = quadget( 1,
     $                             co(m,im2,j,k,il,kz),
     $                             co(m,im1,j,k,il,kz),
     $                             co(m,ihi,j,k,il,kz) )
c-debug-chk[
c-debug-chk;                              if ( t6list(k) .gt. 0.09999 ) then
c-debug-chk;                                 dif = co(m,i,j,k,il,kz)
c-debug-chk;     $                                -co(m,ihi,j,k,il,kz)
c-debug-chk;                                 difl = co(m,i,j,k,il,kz)
c-debug-chk;     $                                -co(m,im1,j,k,il,kz)
c-debug-chk;                                 difmax = max(dif,difmax)
c-debug-chk;                                 difmin = min(dif,difmin)
c-debug-chk;                                 sumdif = sumdif+dif
c-debug-chk;                                 sumsq = sumsq+dif**2
c-debug-chk;                                 numsq = numsq+1
c-debug-chk;                                 diflmax = max(difl,diflmax)
c-debug-chk;                                 diflmin = min(difl,diflmin)
c-debug-chk;                                 sumldif = sumldif+difl
c-debug-chk;                                 sumlsq = sumlsq+difl**2
c-debug-chk;                              endif
c-debug-chk]
                           endif
                        enddo
                     enddo
                     ico_got(i,j) = -1
c					! else, if C < O in missing table, but
c					       ! it is not on the diagonal Y=0:
                  else if ( i .lt. ihi ) then
c					      ! then the only O-value that can
c					      ! be missing is next-to-highest
c						      ! one, at j = n(m,i,kz)-1
c
                     if ( ico_got(i,mo) .le. 0 )
     $                    write(6,2873) z,m,i,mo,n(m,1,kz)-1,
     $                    xcs(i),1.-xa(m)-zat-xcs(i)
                     if ( j .lt. 3 .or. j .ne. n(m,i,kz)-1 )
     $                    write(6,2873) z,m,i,j,ihi,
     $                    min(xcs(i),1.-xa(m)-zat-oat),oat,
     $                    ' n(m,i)=',n(m,i,kz)
 2873                format(' '/'     Z=',f9.7,' ??? CANNOT miss',
     $                    ' mix (m=',i1,',i=',i1,',j=',i1,
     $                    ') with ihi=',i1,' C=',f10.7,' O=',f10.7,
     $                    a8,i1)
                     if ( ico_got(i,mo) .le. 0 .or.
     $                    j .lt. 3 .or. j .ne. n(m,i,kz)-1 ) stop
     $                    ' STOP -- READCO: missing mix: CANNOT be. '
c
                     jm2 = j - 2
                     jm1 = j - 1
                     oxhi = log10( 1. - xa(m) - zat - xcs(i)
     $                    + zzz(kz) )
c-debug-chk[
c-debug-chk;                     write(6,2974) i,j,'O',xos(j),'O',ox(j),
c-debug-chk;     $                    i,jm2,i,jm1,i,mo,'O',xos(jm2),xos(jm1),
c-debug-chk;     $                    1.-xa(m)-zat-xcs(i),
c-debug-chk;     $                    'O',ox(jm2),ox(jm1),oxhi
c-debug-chk; 2974                format('      --- interpolate (',i1,',',i1,
c-debug-chk;     $                    ') in ',a1,'=',f10.6,' log',a1,'=',f10.6,
c-debug-chk;     $                    ' among (',i1,',',i1,') (',i1,',',i1,
c-debug-chk;     $                    ') (',i1,',',i1,'): ',a1,'=',3f10.6,
c-debug-chk;     $                    ' log',a1,'=',3f10.6)
c-debug-chk]
c				! interpolate in O to get missing table:
c
                     call quadsto( 1, ox(j), ox(jm2), ox(jm1), oxhi )
                     do il = 1, nr
                        do k = 1, nt
                           if ( abs( co(m,i,jm1,k,il,kz) ) .lt.
     $                          badlogklim ) then
                              co(m,i,j,k,il,kz) = quadget( 1,
     $                             co(m,i,jm2,k,il,kz),
     $                             co(m,i,jm1,k,il,kz),
     $                             co(m,i,mo,k,il,kz) )
c-debug-chk[
c-debug-chk;                              if ( t6list(k) .gt. 0.09999 ) then
c-debug-chk;                                 dif = co(m,i,j,k,il,kz)
c-debug-chk;     $                                -co(m,i,mo,k,il,kz)
c-debug-chk;                                 difl = co(m,i,j,k,il,kz)
c-debug-chk;     $                                -co(m,i,jm1,k,il,kz)
c-debug-chk;                                 difmax = max(dif,difmax)
c-debug-chk;                                 difmin = min(dif,difmin)
c-debug-chk;                                 sumdif = sumdif+dif
c-debug-chk;                                 sumsq = sumsq+dif**2
c-debug-chk;                                 numsq = numsq+1
c-debug-chk;                                 diflmax = max(difl,diflmax)
c-debug-chk;                                 diflmin = min(difl,diflmin)
c-debug-chk;                                 sumldif = sumldif+difl
c-debug-chk;                                 sumlsq = sumlsq+difl**2
c-debug-chk;                              endif
c-debug-chk]
                           endif
                        enddo
                     enddo
                     ico_got(i,j) = -1
c					! else, if C < O in missing table, and
c					!  it is on the diagonal Y=0 (note that
c					!  this never actually happens):
                  else
                     nmorat = 3
                     j3 = 3
                     do while( j3 .lt. no - 1 .and. cat .gt. xcs(j3)
     $                    .and. ico_got(j3+1,mo) .gt. 0 )
                        j3 = j3 + 1
                     enddo
                     j4 = j3 + 1
                     if ( j4 .ge. no .or. ico_got(j4,mo) .le. 0 ) then
                        j4 = j3
                        nmorat = 2
                     endif
                     j2 = j3 - 1
                     j1 = j2 - 1
c
                     if ( ico_got(j1,mo) .le. 0 ) write(6,4873)
     $                    zat,m,j1,mo,no-1,xcs(j1),1.-xa(m)-zat-xcs(j1)
                     if ( ico_got(j2,mo) .le. 0 ) write(6,4873)
     $                    zat,m,j2,mo,no-1,xcs(j2),1.-xa(m)-zat-xcs(j2)
                     if ( ico_got(j3,mo) .le. 0 ) write(6,4873)
     $                    zat,m,j3,mo,no-1,xcs(j3),1.-xa(m)-zat-xcs(j3)
 4873                format(' '/'     Z=',f9.7,' ??? CANNOT miss',
     $                    ' mix (m=',i1,',i=',i1,',j=',i1,
     $                    ') with ihi=',i1,' C=',f10.7,' O=',f10.7)
                     if ( ico_got(j1,mo) .le. 0 .or.
     $                    ico_got(j2,mo) .le. 0 .or.
     $                    ico_got(j3,mo) .le. 0 ) stop
     $                    ' STOP -- READCO: missing mix: CANNOT be. '
c
c-debug-chk[
c-debug-chk;                     write(6,1975) i,j,'C',cat,'C',cx(i),
c-debug-chk;     $                    nmorat+1,j1,mo,j2,mo,j3,mo,j4,mo,
c-debug-chk;     $                    'C',xcs(j1),xcs(j2),xcs(j3),xcs(j4),
c-debug-chk;     $                    'C',cx(j1),cx(j2),cx(j3),cx(j4)
c-debug-chk; 1975                format(' (',i1,',',i1,') ',a1,'=',f10.6,
c-debug-chk;     $                    ' log',a1,'=',f10.6,' among',i2,
c-debug-chk;     $                    ' of (',i1,',',i1,') (',i1,',',i1,
c-debug-chk;     $                    ') (',i1,',',i1,') (',i1,',',i1,'): ',
c-debug-chk;     $                    a1,'=',4f10.6,' log',a1,'=',4f10.6)
c-debug-chk]
                     is = 0
                     do il = 1, nr
                        do k = 1, nt
                           if ( abs( co(m,j1,mo,k,il,kz) ) .lt.
     $                          badlogklim ) then
                              co(m,i,j,k,il,kz) = qzinter(is,1,cat,
     $                             nmorat,co(m,j1,mo,k,il,kz),
     $                             co(m,j2,mo,k,il,kz),
     $                             co(m,j3,mo,k,il,kz),
     $                             co(m,j4,mo,k,il,kz),xcs(j1),
     $                             xcs(j2),xcs(j3),xcs(j4),zzz(kz))
                              is = 1
c-debug-chk[
c-debug-chk;                              if ( t6list(k) .gt. 0.09999 ) then
c-debug-chk;                                 dif = co(m,i,j,k,il,kz)
c-debug-chk;     $                                -co(m,j3,mo,k,il,kz)
c-debug-chk;                                 difl = co(m,i,j,k,il,kz)
c-debug-chk;     $                                -co(m,j2,mo,k,il,kz)
c-debug-chk;                                 difmax = max(dif,difmax)
c-debug-chk;                                 difmin = min(dif,difmin)
c-debug-chk;                                 sumdif = sumdif+dif
c-debug-chk;                                 sumsq = sumsq+dif**2
c-debug-chk;                                 numsq = numsq+1
c-debug-chk;                                 diflmax = max(difl,diflmax)
c-debug-chk;                                 diflmin = min(difl,diflmin)
c-debug-chk;                                 sumldif = sumldif+difl
c-debug-chk;                                 sumlsq = sumlsq+difl**2
c-debug-chk;                              endif
c-debug-chk]
                           endif
                        enddo
                     enddo
                     ico_got(i,j) = -1
c-debug-chk[
c-debug-chk;                     write(6,8712) numsq,diflmin,diflmax,
c-debug-chk;     $                    sumldif/max(numsq,1),
c-debug-chk;     $                    sqrt(sumlsq/max(numsq,1)),
c-debug-chk;     $                    numsq,difmin,difmax,sumdif/max(numsq,1),
c-debug-chk;     $                    sqrt(sumsq/max(numsq,1))
c-debug-chk; 8712                format(' '/'      ',
c-debug-chk;     $                    ' --- result: relative DIFmid:',
c-debug-chk;     $                    i5,'[',f10.6,' ,',f10.6,' ]ave',f10.6,
c-debug-chk;     $                    ' rms',f10.6,'  DIFhi:',i5,'[',f10.6,
c-debug-chk;     $                    ' ,',f10.6,' ]ave',f10.6,' rms',f10.6)
c-debug-chk]
                  endif
               endif
            enddo
         enddo
c			   ! next, remaining diagonal tables (at Y=0):
c			   !  (only the table at no-1 can possibly be missing)
         do j = 1, no - 2
            if ( ico_got(j,mo) .eq. 0 ) write(6,3873)
     $           zat,m,j,mo,no-1,xcs(j),1.-xa(m)-zat-xcs(j)
 3873       format(' '/'     Z=',f9.7,' ??? CANNOT miss',
     $           ' mix (m=',i1,',i=',i1,',j=',i1,
     $           ') with ihi=',i1,' C=',f10.7,' O=',f10.7)
            if ( ico_got(j,mo) .eq. 0 ) stop
     $           ' STOP -- READCO: missing mix: CANNOT be. '
         enddo
c
         j = no - 1
c						! if table at no-1 is missing:
         if ( ico_got(j,mo) .eq. 0 ) then
            oat = 1. - xa(m) - zat - xcs(j)
c-debug-chk[
c-debug-chk;            write(6,4973) m,zat,j,mo,no-1,xcs(j),oat
c-debug-chk; 4973       format(' '/'     Z=',f9.7,' --- interpolate',
c-debug-chk;     $           ' mix (m=',i1,',i=',i1,',j=',i1,
c-debug-chk;     $           ') with ihi=',i1,' C=',f10.7,' O=',f10.7)
c-debug-chk;            difmax = -9.999999
c-debug-chk;            difmin = 9.999999
c-debug-chk;            sumdif = 0.
c-debug-chk;            sumsq = 0.
c-debug-chk;            numsq = 0
c-debug-chk;            diflmax = -9.999999
c-debug-chk;            diflmin = 9.999999
c-debug-chk;            sumldif = 0.
c-debug-chk;            sumlsq = 0.
c-debug-chk]
c			! may use quadratic, or two overlapping quadratics
            nmorat = 3
            j3 = 3
            do while( j3 .lt. no - 1 .and. oat .gt. xos(j3) .and.
     $           ico_got(max(n(m,j3+1,kz),1),j3+1) .gt. 0 )
               j3 = j3+1
            enddo
            j4 = j3+1
            if ( j4 .ge. no .or.
     $           ico_got(j4,max(n(m,j4,kz),1)) .le. 0 ) then
               j4 = j3
               nmorat = 2
            endif
            j2 = j3-1
            j1 = j2-1
c-noneed[                                                     ! (checked above)
c-noneed;            if ( ico_got(n(m,j1,kz),j1) .le. 0 .or.
c-noneed;     $           ico_got(n(m,j2,kz),j2) .le. 0 .or.
c-noneed;     $           ico_got(n(m,j3,kz),j3) .le. 0 ) stop
c-noneed;     $           ' STOP -- READCO: mix CANNOT be missing. '
c-noneed]
c-debug-chk[
c-debug-chk;            write(6,2975) j,mo,'O',oat,'O',log10(oat+zzz(kz)),
c-debug-chk;     $           nmorat+1,n(m,j1,kz),j1,n(m,j2,kz),j2,
c-debug-chk;     $           n(m,j3,kz),j3,n(m,j4,kz),j4,
c-debug-chk;     $           'O',xos(j1),xos(j2),xos(j3),xos(j4),
c-debug-chk;     $           'O',ox(j1),ox(j2),ox(j3),ox(j4)
c-debug-chk; 2975       format(' (',i1,',',i1,') ',a1,'=',f10.6,
c-debug-chk;     $           ' log',a1,'=',f10.6,' among',i2,
c-debug-chk;     $           ' of (',i1,',',i1,') (',i1,',',i1,
c-debug-chk;     $           ') (',i1,',',i1,') (',i1,',',i1,'): ',
c-debug-chk;     $           a1,'=',4f10.6,' log',a1,'=',4f10.6)
c-debug-chk]
c			! interpolate along the diagonal (using O-abundance)
            is = 0
            do il = 1, nr
               do k = 1, nt
                  if ( abs( co(m,n(m,j1,kz),j1,k,il,kz) ) .lt.
     $                 badlogklim ) then
                     co(m,j,mo,k,il,kz) = qzinter(is,1,oat,nmorat,
     $                    co(m,n(m,j1,kz),j1,k,il,kz),
     $                    co(m,n(m,j2,kz),j2,k,il,kz),
     $                    co(m,n(m,j3,kz),j3,k,il,kz),
     $                    co(m,n(m,j4,kz),j4,k,il,kz),
     $                    xos(j1),xos(j2),xos(j3),xos(j4),zzz(kz))
                     is = 1
c-debug-chk[
c-debug-chk;                     if ( t6list(k) .gt. 0.09999 ) then
c-debug-chk;                        dif = co(m,j,mo,k,il,kz)
c-debug-chk;     $                       - co(m,n(m,j3,kz),j3,k,il,kz)
c-debug-chk;                        difl = co(m,j,mo,k,il,kz)
c-debug-chk;     $                       - co(m,n(m,j2,kz),j2,k,il,kz)
c-debug-chk;                        difmax = max(dif,difmax)
c-debug-chk;                        difmin = min(dif,difmin)
c-debug-chk;                        sumdif = sumdif+dif
c-debug-chk;                        sumsq = sumsq+dif**2
c-debug-chk;                        numsq = numsq+1
c-debug-chk;                        diflmax = max(difl,diflmax)
c-debug-chk;                        diflmin = min(difl,diflmin)
c-debug-chk;                        sumldif = sumldif+difl
c-debug-chk;                        sumlsq = sumlsq+difl**2
c-debug-chk;                     endif
c-debug-chk]
                  endif
               enddo
            enddo
            ico_got(j,mo) = -1
c-debug-chk[
c-debug-chk;            write(6,7712) numsq,diflmin,diflmax,
c-debug-chk;     $           sumldif/max(numsq,1),
c-debug-chk;     $           sqrt(sumlsq/max(numsq,1)),
c-debug-chk;     $           numsq,difmin,difmax,sumdif/max(numsq,1),
c-debug-chk;     $           sqrt(sumsq/max(numsq,1))
c-debug-chk; 7712       format(' '/'      ',
c-debug-chk;     $           ' --- result: relative DIFmid:',
c-debug-chk;     $           i5,'[',f10.6,' ,',f10.6,' ]ave',f10.6,
c-debug-chk;     $           ' rms',f10.6,'  DIFhi:',i5,'[',f10.6,
c-debug-chk;     $           ' ,',f10.6,' ]ave',f10.6,' rms',f10.6)
c-debug-chk]
         endif
c                                                      0.10-- @ +   +     @
c  If possible, make mixes next to the C=O=0.0       C
c   mix smooth for CO-interpolation (but only if
c   low_CO_smo > 0 in common /c_opal_ctrl_smooth/).    0.03-- @ +   @     +
c   The diagram at right, of the lower-left corner
c   of the C-O plane, shows the mixes that may be      0.01-- * *   +     +
c   interpolated as "*" , the mixes interpolated       0.00-- @ *   @     @
c   among as "@" , and unused mixes as "+".                   | |   |     |
c                                                            0. |  .03   .10
c                                                              .01           O
         if ( low_CO_smo .gt. 0 ) then
            call quadsto( 1, oxf(m,2,kz), oxf(m,1,kz),
     $                    oxf(m,3,kz), oxf(m,4,kz) )
c-debug-chk[
c-debug-chk;            difmax = -9.999999
c-debug-chk;            difmin = 9.999999
c-debug-chk;            sumdif = 0.
c-debug-chk;            sumsq = 0.
c-debug-chk;            numsq = 0
c-debug-chk;            diflmax = -9.999999
c-debug-chk;            diflmin = 9.999999
c-debug-chk;            sumldif = 0.
c-debug-chk;            sumlsq = 0.
c-debug-chk;            numlsq = 0
c-debug-chk]
c				! loop over the three mixes next to C=O=0.0 mix
            do imix = 1, 3
               ifac = ( 4 - imix ) / 2
               ifac1 = ifac + 1
               ifac2 = ifac1 + ifac
               ifac3 = ifac2 + ifac
               jfac = imix / 2
               jfac1 = jfac + 1
               jfac2 = jfac1 + jfac
               jfac3 = jfac2 + jfac
               do il = 1, nr
                  do k = 1, nt
                     v1 = co(m,1,1,k,il,kz)
                     if ( abs(v1) .lt. badlogklim ) then
                        v2 = co(m,ifac1,jfac1,k,il,kz)
                        v3 = co(m,ifac2,jfac2,k,il,kz)
                        v4 = co(m,ifac3,jfac3,k,il,kz)
                        cofmin = min( .8*v1+.2*v3 , .2*v1+.8*v3 )
                        cofmax = max( .8*v1+.2*v3 , .2*v1+.8*v3 )
                        if ( (v4-v3)*(v3-v1) .gt. 0. .and. 
     $                       ( v2 .lt. cofmin .or.
     $                       v2 .gt. cofmax ) ) then
                           co(m,ifac1,jfac1,k,il,kz) = max( min(
     $                          quadget( 1, v1, v3, v4 ) ,
     $                          cofmax ) , cofmin )
c-debug-chk[
c-debug-chk;                           dif = co(m,1+ifac,1+jfac,k,il,kz)-v2
c-debug-chk;                           if ( t6list(k) .gt. 0.09999 ) then
c-debug-chk;                              difmax = max(dif,difmax)
c-debug-chk;                              difmin = min(dif,difmin)
c-debug-chk;                              sumdif = sumdif+dif
c-debug-chk;                              sumsq = sumsq+dif**2
c-debug-chk;                              numsq = numsq+1
c-debug-chk;                           else
c-debug-chk;                              diflmax = max(dif,diflmax)
c-debug-chk;                              diflmin = min(dif,diflmin)
c-debug-chk;                              sumldif = sumldif+dif
c-debug-chk;                              sumlsq = sumlsq+dif**2
c-debug-chk;                              numlsq = numlsq+1
c-debug-chk;                           endif
c-debug-chk]
                        endif
                     endif
                  enddo
               enddo
            enddo
c-debug-chk[
c-debug-chk;            write(6,8733) m,zat,numlsq,diflmin,diflmax,
c-debug-chk;     $           sumldif/max(numlsq,1),
c-debug-chk;     $           sqrt(sumlsq/max(numlsq,1)),
c-debug-chk;     $           numsq,difmin,difmax,sumdif/max(numsq,1),
c-debug-chk;     $           sqrt(sumsq/max(numsq,1))
c-debug-chk; 8733       format(' '/' m=',i1,' Z=',f9.7,
c-debug-chk;     $           ' fix C,O=[1,2] T6<0.1:',
c-debug-chk;     $           i5,'[',f10.6,' ,',f10.6,' ]ave',f10.6,
c-debug-chk;     $           ' rms',f10.6,' T6>0.1:',i5,'[',f10.6,' ,',
c-debug-chk;     $           f10.6,' ]ave',f10.6,' rms',f10.6)
c-debug-chk]
         endif
c
c  Peform any specified opacity shifts, from GN93hz and [O/Fe]
c
         if ( m .eq. 1 ) then
c				     ! if needed, get Z-composition of GS98 mix
            if ( klozat .eq. 1 ) then
c
               do i = 1, nel_zmix
                  xiz_mix(i) = xiz_opalGS98(i,1)
                  fninz_mix(i) = fninz_opalGS98(i,1)
                  bracketife_mix(i) = 0.
               enddo
c							       ! or of GN93 mix
            else if ( khizat .eq. 1 .and. klozat .eq. 0 ) then
c
               do i = 1, nel_zmix
                  xiz_mix(i) = xiz_opalmixes(i,1)
                  fninz_mix(i) = fninz_opalmixes(i,1)
                  bracketife_mix(i) = 0.
               enddo
c
            endif
c
         endif
c						   ! If GN93 m=2 shift, [O/Fe]:
         if ( khizat .eq. 1 .and. m .eq. mx03 .and.
     $        klozat .eq. 0 ) then
c						! set all shifts to zero
c			  ! (m=2 GN93hz shift may be interpolated later)
            do il = 1, nr
               do k = 1, nt
                  co(m,mc,mo_m1,k,il,kz) = 0.
                  co(m,mc,mo,k,il,kz) = 0.
               enddo
            enddo
c					       ! Else, if there are any shifts:
         else if ( khizat .gt. 0 ) then
c					       ! If GN93 but no [O/Fe] shift:
c
            if ( khizat .eq. 1 .and. klozat .eq. 0 ) then
c							  ! then set it to zero
               do il = 1, nr
                  do k = 1, nt
                     co(m,mc,mo_m1,k,il,kz) = 0.
                  enddo
               enddo
c			! Else, if there is the [O/Fe] or the GS98-GN93 shift:
            else
c		! get interpolation factors fofe (for GN93hz) and omfofe=1-fofe
c					 ! & Z-composition of interpolated mix
               if ( klozat .gt. 1 ) then
c							  ! GS98 + [O/Fe] shift
                  xofe = 10.**ofebrack * xofe_opalGS98(1)
                  fofe = ( fninz_opalGS98(kel_o,klozat)
     $                 - xofe * fninz_opalGS98(kel_fe,klozat) )
     $                 / ( ( fninz_opalGS98(kel_fe,1)
     $                 - fninz_opalGS98(kel_fe,klozat) ) * xofe
     $                 + fninz_opalGS98(kel_o,klozat)
     $                 - fninz_opalGS98(kel_o,1) )
                  omfofe = 1. - fofe
                  mofe = mo_m2
                  moat = mo_m1
c					! get Z-composition of interpolated mix
                  if ( m .eq. 1 ) then
                     sum_niai = 0.0
                     do i = 1, nel_zmix
                        fninz_mix(i) = fofe * fninz_opalGS98(i,1)
     $                       + omfofe * fninz_opalGS98(i,klozat)
                        xiz_mix(i) = fninz_mix(i) * atwt_opalGS98(i)
                        sum_niai = sum_niai + xiz_mix(i)
                     enddo
                     do i = 1, nel_zmix
                        xiz_mix(i) = xiz_mix(i) / sum_niai
                        bracketife_mix(i) = log10(
     $                       ( max( fninz_mix(i) , 1.e-36 )
     $                       * fninz_opalGS98(kel_fe,1) )
     $                       / ( max( fninz_mix(kel_fe) , 1.e-36 )
     $                       * fninz_opalGS98(i,1) ) )
                     enddo
c-debug-chk[
c-debug-chk;                     if ( iout_debug_chk_ofe .gt. 0 ) then
c-debug-chk;                        write(6,2377) ofebrack,-klozat,
c-debug-chk;     $                       bracketofe_opalGS98(klozat),
c-debug-chk;     $                       fofe,klozat,omfofe,klozat,klozat
c-debug-chk; 2377                   format(' '/' To get mix with [O/Fe] =',
c-debug-chk;     $                       f11.7,' from mix',i2,' with [O/Fe] =',
c-debug-chk;     $                       f11.7,': f_(1) =',f11.7,' , f_(',i1,
c-debug-chk;     $                       ') =',f11.7,':'/' '/
c-debug-chk;     $                       '  i   Xi/Z_(1)   Ni/Nz_(1)',
c-debug-chk;     $                       '   Xi/Z_(',i1,')   Ni/Nz_(',i1,')',
c-debug-chk;     $                       '   Xi/Z_mix   Ni/Nz_mix   [i/Fe]'/
c-debug-chk;     $                       ' ==  ========== ==========',
c-debug-chk;     $                       '  ========== ==========  ==========',
c-debug-chk;     $                       ' ========== ==========')
c-debug-chk;                        do i = 1,nel_zmix
c-debug-chk;                           write(6,2376) cel_opalmixes(i),
c-debug-chk;     $                          xiz_opalGS98(i,1),
c-debug-chk;     $                          fninz_opalGS98(i,1),
c-debug-chk;     $                          xiz_opalGS98(i,klozat),
c-debug-chk;     $                          fninz_opalGS98(i,klozat),
c-debug-chk;     $                          xiz_mix(i),fninz_mix(i),
c-debug-chk;     $                          bracketife_mix(i)
c-debug-chk; 2376                      format(' ',a2,3(f12.7,f11.7),f11.7)
c-debug-chk;                        enddo
c-debug-chk;                        write(6,'(" ")')
c-debug-chk;                        iout_debug_chk_ofe = iout_debug_chk_ofe - 1
c-debug-chk;                     endif
c-debug-chk]
                  endif
c
               else if ( khizat .gt. 1 ) then
c							   ! [O/Fe] shift only
                  xofe = 10.**ofebrack * xofe_opalmixes(1)
                  fofe = ( fninz_opalmixes(kel_o,khizat)
     $                 - xofe * fninz_opalmixes(kel_fe,khizat) )
     $                 / ( ( fninz_opalmixes(kel_fe,1)
     $                 - fninz_opalmixes(kel_fe,khizat) ) * xofe
     $                 + fninz_opalmixes(kel_o,khizat)
     $                 - fninz_opalmixes(kel_o,1) )
                  omfofe = 1. - fofe
                  mofe = mo_m1
                  moat = mo
c					! get Z-composition of interpolated mix
                  if ( m .eq. 1 ) then
                     sum_niai = 0.0
                     do i = 1, nel_zmix
                        fninz_mix(i) = fofe * fninz_opalmixes(i,1)
     $                       + omfofe * fninz_opalmixes(i,khizat)
                        xiz_mix(i) = fninz_mix(i) * atwt_opalGS98(i)
                        sum_niai = sum_niai + xiz_mix(i)
                     enddo
                     do i = 1, nel_zmix
                        xiz_mix(i) = xiz_mix(i) / sum_niai
                        bracketife_mix(i) = log10(
     $                       ( max( fninz_mix(i) , 1.e-36 )
     $                       * fninz_opalmixes(kel_fe,1) )
     $                       / ( max( fninz_mix(kel_fe) , 1.e-36 )
     $                       * fninz_opalmixes(i,1) ) )
                     enddo
c-debug-chk[
c-debug-chk;                     if ( iout_debug_chk_ofe .gt. 0 ) then
c-debug-chk;                        write(6,2377) ofebrack,khizat,
c-debug-chk;     $                       bracketofe_opalmixes(khizat),
c-debug-chk;     $                       fofe,khizat,omfofe,khizat,khizat
c-debug-chk;                        do i = 1,nel_zmix
c-debug-chk;                           write(6,2376) cel_opalmixes(i),
c-debug-chk;     $                          xiz_opalmixes(i,1),
c-debug-chk;     $                          fninz_opalmixes(i,1),
c-debug-chk;     $                          xiz_opalmixes(i,khizat),
c-debug-chk;     $                          fninz_opalmixes(i,khizat),
c-debug-chk;     $                          xiz_mix(i),fninz_mix(i),
c-debug-chk;     $                          bracketife_mix(i)
c-debug-chk;                        enddo
c-debug-chk;                        write(6,'(" ")')
c-debug-chk;                        iout_debug_chk_ofe = iout_debug_chk_ofe - 1
c-debug-chk;                     endif
c-debug-chk]
                  endif
c
               else
c				! GS98 shift only
                  mofe = mo_m1
                  moat = mo_m1
                  fofe = 0.
                  omfofe = 1.
c
               endif
c		     ! compute [O/Fe],GS98 shifts relative to GN93hz opacities
c-debug-chk[
c-debug-chk;               sumsq = 0.
c-debug-chk;               sumdif = 0.
c-debug-chk;               difmax = -9.999999
c-debug-chk;               difmin = 9.999999
c-debug-chk;               numsq = 0
c-debug-chk]
               do il = 1, nr
                  do k = nt, 1, -1
                     if ( abs( co(m,mc,mo_m1,k,il,kz) ) .lt. badlogklim
     $                    .and. abs( co(m,mc,mo,k,il,kz) ) .lt.
     $                    badlogklim .and. abs( co(m,mc,mofe,k,il,kz) )
     $                    .lt. badlogklim ) then
                        dif = ( co(m,mc,mofe,k,il,kz) * omfofe
     $                       + co(m,mc,moat,k,il,kz) * fofe )
     $                       - co(m,mc,mo,k,il,kz)
                        co(m,mc,mo_m1,k,il,kz) = dif
c-debug-chk[
c-debug-chk;                        if ( t6list(k) .gt. 0.009999 ) then
c-debug-chk;                           sumdif = sumdif+dif
c-debug-chk;                           sumsq = sumsq+dif**2
c-debug-chk;                           difmax = max(dif,difmax)
c-debug-chk;                           difmin = min(dif,difmin)
c-debug-chk;                           numsq = numsq+1
c-debug-chk;                        endif
c-debug-chk]
                     else if ( k .lt. nt ) then
                        co(m,mc,mo_m1,k,il,kz) =
     $                       co(m,mc,mo_m1,k+1,il,kz)
                     else if ( il .gt. 1 ) then
                        co(m,mc,mo_m1,k,il,kz) = 
     $                       co(m,mc,mo_m1,k,il-1,kz)
                     else
                        co(m,mc,mo_m1,k,il,kz) = 0.
                     endif
                  enddo
               enddo
c-debug-chk[
c-debug-chk;               write(6,2379) m,zat,numsq,difmin,difmax,
c-debug-chk;     $              sumdif/max(numsq,1),sqrt(sumsq/max(numsq,1)),
c-debug-chk;     $              sqrt(max(sumsq-sumdif**2/max(numsq,1),0.)
c-debug-chk;     $              /max(numsq-1,1))
c-debug-chk; 2379          format(' '/' m=',i1,' Z=',f9.7,
c-debug-chk;     $              ' [O/Fe] deltas for T6>0.01: N=',
c-debug-chk;     $              i4,' DEL[',f10.6,' ,',f10.6,' ] DELave=',f10.6,
c-debug-chk;     $              ' DELrms=',f10.6,' sig',f10.6)
c-debug-chk]
            endif
c			! compute GN93hz shifts relative to Gz???.x?? opacities
c-debug-chk[
c-debug-chk;            difmax = -9.999999
c-debug-chk;            difmin = 9.999999
c-debug-chk;            sumdif = 0.
c-debug-chk;            sumsq = 0.
c-debug-chk;            numsq = 0
c-debug-chk]
c-test-xdel[
c-test-xdel;            do ij = 1,n_xdtst
c-test-xdel;               dif_tst(1,ij) = -9.999999
c-test-xdel;               dif_tst(2,ij) = 9.999999
c-test-xdel;               dif_tst(3,ij) = 0.
c-test-xdel;               dif_tst(4,ij) = 0.
c-test-xdel;            enddo
c-test-xdel]
c				! note: facxhz=0.0 for m=2, <1.0 for .04<Z<.06
            do il = 1, nr
               do k = nt, 1, -1
                  if ( abs( co(m,mc,mo,k,il,kz) ) .lt. badlogklim .and.
     $                 abs( co(m,1,1,k,il,kz) ) .lt. badlogklim ) then
                     dif = co(m,mc,mo,k,il,kz) - co(m,1,1,k,il,kz)
c
c							! (reduce GN93hz shifts
c							! by the factor facxhz)
                     co(m,mc,mo,k,il,kz) = dif * facxhz
c-debug-chk[
c-debug-chk;                     if ( t6list(k) .gt. 0.009999 ) then
c-debug-chk;                        difmax = max(dif,difmax)
c-debug-chk;                        difmin = min(dif,difmin)
c-debug-chk;                        sumdif = sumdif+dif
c-debug-chk;                        sumsq = sumsq+dif**2
c-debug-chk;                        numsq = numsq+1
c-debug-chk;                     endif
c-debug-chk]
c-test-xdel[
c-test-xdel;                     if ( t6list(k) .gt. 0.009999 ) then
c-test-xdel;                        if ( nxdo .eq. 3 ) then
c-test-xdel;                           do ij = 1,n_xdtst
c-test-xdel;                              dtst = cof_tst(k+ntdel,il+nrdel,ij)
c-test-xdel;     $                             -co(m,1,1,k,il,kz)
c-test-xdel;                              dif_tst(1,ij) = max(dif_tst(1,ij),
c-test-xdel;     $                             dtst)
c-test-xdel;                              dif_tst(2,ij) = min(dif_tst(2,ij),
c-test-xdel;     $                             dtst)
c-test-xdel;                              dif_tst(3,ij) = dif_tst(3,ij)+dtst
c-test-xdel;                              dif_tst(4,ij) = dif_tst(4,ij)+dtst**2
c-test-xdel;                           enddo
c-test-xdel;                        endif
c-test-xdel;                     endif
c-test-xdel]
                  else if ( k .lt. nt ) then
                     co(m,mc,mo,k,il,kz) = co(m,mc,mo,k+1,il,kz)
                  else if ( il .gt. 1 ) then
                     co(m,mc,mo,k,il,kz) = co(m,mc,mo,k,il-1,kz)
                  else
                     co(m,mc,mo,k,il,kz) = 0.
                  endif
               enddo
            enddo
c-debug-chk[
c-debug-chk;            write(6,2378) m,zat,numsq,difmin,difmax,
c-debug-chk;     $           sumdif/max(numsq,1),sqrt(sumsq/max(numsq,1)),
c-debug-chk;     $           sqrt(max(sumsq-sumdif**2/max(numsq,1),0.)
c-debug-chk;     $           /max(numsq-1,1)),facxhz
c-debug-chk; 2378       format(' '/' m=',i1,' Z=',f9.7,
c-debug-chk;     $           ' GN93hz deltas for T6>0.01: N=',
c-debug-chk;     $           i4,' DEL[',f10.6,' ,',f10.6,' ] DELave=',f10.6,
c-debug-chk;     $           ' DELrms=',f10.6,' sig',f10.6,
c-debug-chk;     $           ' reduced by facxhz=',f10.7)
c-debug-chk]
c-test-xdel[
c-test-xdel;            if ( nxdo .eq. 3 ) then
c-test-xdel;               do ij = 1,n_xdtst
c-test-xdel;                  write(6,5817) numsq,dif_tst(1,ij),dif_tst(2,ij),
c-test-xdel;     $                 dif_tst(3,ij)/max(numsq,1),
c-test-xdel;     $                 sqrt(dif_tst(4,ij)/max(numsq,1)),
c-test-xdel;     $                 sqrt(max(dif_tst(4,ij)-dif_tst(3,ij)**2
c-test-xdel;     $                 /max(numsq,1),0.)/max(numsq-1,1)),
c-test-xdel;     $                 xdel_tst(ij)
c-test-xdel; 5817             format('                ',
c-test-xdel;     $                 ' GN93hz deltas for T6>0.01: N=',i4,
c-test-xdel;     $                 ' DEL[',f10.6,' ,',f10.6,' ] DELave=',f10.6,
c-test-xdel;     $                 ' DELrms=',f10.6,' sig',f10.6,
c-test-xdel;     $                 ' for Xdel=',f6.4)
c-test-xdel;               enddo
c-test-xdel;            endif
c-test-xdel]
         endif
c-debug-chk[
c-debug-chk;         do i = 1,no-1
c-debug-chk;            oat = 1.-xa(m)-zat-xcs(i)
c-debug-chk;            io = -1
c-debug-chk;            do j = 1,no-1
c-debug-chk;               ihi = n(m,j,kz)
c-debug-chk;               cat = min(xcs(ihi),1.-xa(m)-zat-xos(j))
c-debug-chk;               if ( max( abs(xcs(i)-cat) , abs(oat-xos(j)) )
c-debug-chk;     $              .lt. 0.0011 ) then
c-debug-chk;                  io = ihi
c-debug-chk;                  jo = j
c-debug-chk;               endif
c-debug-chk;            enddo
c-debug-chk;            if ( io .gt. 0 ) then
c-debug-chk;               difmax = -9.999999
c-debug-chk;               difmin = 9.999999
c-debug-chk;               sumdif = 0.
c-debug-chk;               sumsq = 0.
c-debug-chk;               numsq = 0
c-debug-chk;               do il = 1,nr
c-debug-chk;                  do k = 6,nta(il+nrdel)-ntdel
c-debug-chk;                     dif = co(m,io,jo,k,il,kz)-co(m,i,mo,k,il,kz)
c-debug-chk;                     difmax = max(dif,difmax)
c-debug-chk;                     difmin = min(dif,difmin)
c-debug-chk;                     sumdif = sumdif+dif
c-debug-chk;                     sumsq = sumsq+dif**2
c-debug-chk;                     numsq = numsq+1
c-debug-chk;                  enddo
c-debug-chk;               enddo
c-debug-chk;               write(6,1598) m,zat,io,jo,i,mo,numsq,difmin,difmax,
c-debug-chk;     $              sumdif/max(numsq,1),sqrt(sumsq/max(numsq,1)),
c-debug-chk;     $              min(xcs(io),1.-xa(m)-z-xos(jo)),xos(jo),
c-debug-chk;     $              xcs(i),1.-xa(m)-z-xcs(i)
c-debug-chk; 1598          format(' '/' m=',i1,' Z=',f9.7,' d:(',i1,',',i1,
c-debug-chk;     $              ')-(',i1,',',i1,') for T6>0.01: N=',i4,' DIF[',
c-debug-chk;     $              f10.6,' ,',f10.6,' ] DIFave=',f10.6,' DIFrms=',
c-debug-chk;     $              f10.6,' CO',2f10.7,' &',2f10.7)
c-debug-chk;            endif
c-debug-chk;         enddo
c-debug-chk]
c			! End of loop over m values
      enddo
c
c }--------------------------------------- End of loop over m values (X-tables)
c
c-debug-chk[
c-debug-chk;      write(6,8418) (i,(n(i,j,kz),j=1,mo),' ',i=1,mx)
c-debug-chk; 8418 format(' '/' -- n(m,j): ',5(' (m=',i1,')',8i2,a1))
c-debug-chk]
c		! interpolate GN93hz opacity shifts for m=2, if possible; note
c		! that other shifts being interpolated among already contain
c		! the factor of facxhz. No need to revise any m=2 [O/Fe] shift.
c
      if ( khizat .gt. 0 .and. mx .ge. 4 .and.
     $     mxzero .eq. 1 .and. mx03 .eq. 2 ) then
c
c-debug-chk[
c-debug-chk;         sumsq = 0.
c-debug-chk;         sumdif = 0.
c-debug-chk;         difmax = -9.999999
c-debug-chk;         difmin = 9.999999
c-debug-chk;         numsq = 0
c-debug-chk]
         call quadsto( 1, xx(2), xx(1), xx(3), xx(4) )
c
c			! for all densities and temperatures
         do il = 1, nr
            do k = nt, 1, -1
c					! if it is possible to interpolate
c
               if ( abs( co(1,1,1,k,il,kz) ) .lt. badlogklim .and.
     $              abs( co(2,1,1,k,il,kz) ) .lt. badlogklim ) then
c
c							     ! new GN93hz shift
                  dif = quadget( 1, co(1,mc,mo,k,il,kz),
     $                 co(3,mc,mo,k,il,kz), co(4,mc,mo,k,il,kz) )
c-debug-chk[
c-debug-chk;                  if ( t6list(k) .gt. 0.009999 ) then
c-debug-chk;                     sumdif = sumdif+dif
c-debug-chk;                     sumsq = sumsq+dif**2
c-debug-chk;                     difmax = max(dif,difmax)
c-debug-chk;                     difmin = min(dif,difmin)
c-debug-chk;                     numsq = numsq+1
c-debug-chk;                  endif
c-debug-chk]
                  co(2,mc,mo,k,il,kz) = dif
               else if ( k .lt. nt ) then
                  co(2,mc,mo,k,il,kz) = co(2,mc,mo,k+1,il,kz)
               else if ( il .gt. 1 ) then
                  co(2,mc,mo,k,il,kz) = co(2,mc,mo,k,il-1,kz)
               else
                  co(2,mc,mo,k,il,kz) = 0.0
               endif
c
            enddo
         enddo
c-debug-chk[
c-debug-chk;         if ( facxhz .gt. 0. .and. facxhz .lt. 1.  ) then
c-debug-chk;            difmin = difmin/facxhz
c-debug-chk;            difmax = difmax/facxhz
c-debug-chk;            sumdif = sumdif/facxhz
c-debug-chk;            sumsq = sumsq/facxhz**2
c-debug-chk;         else
c-debug-chk;            facxhz = 1.
c-debug-chk;         endif
c-debug-chk;         write(6,2371) z,numsq,difmin,difmax,
c-debug-chk;     $        sumdif/max(numsq,1),sqrt(sumsq/max(numsq,1)),facxhz
c-debug-chk; 2371    format(' '/' m=2 Z=',f9.7,
c-debug-chk;     $        ' GN93hz alt-deltas T6>0.01: N=',
c-debug-chk;     $        i4,' DIF[',f10.6,' ,',f10.6,' ] DIFave=',f10.6,
c-debug-chk;     $        ' DIFrms=',f10.6,' reduced by facxhz=',f10.7)
c-debug-chk]
c		 ! end of interpolation of GN93hz opacity shifts for m=2
      endif
c				! apply all opacity shifts calculated above
      if ( khizat .gt. 0 ) then
c					! Begin loop over m values:
         do m = 1, mx
c
c-debug-chk[
c-debug-chk;            difmax = -9.999999
c-debug-chk;            difmin = 9.999999
c-debug-chk;            sumdif = 0.
c-debug-chk;            sumsq = 0.
c-debug-chk;            numsq = 0
c-debug-chk;            difcmax = -9.999999
c-debug-chk;            difcmin = 9.999999
c-debug-chk;            sumcdif = 0.
c-debug-chk;            sumcsq = 0.
c-debug-chk;            numcsq = 0
c-debug-chk;            diflmax = -9.999999
c-debug-chk;            diflmin = 9.999999
c-debug-chk;            sumldif = 0.
c-debug-chk;            sumlsq = 0.
c-debug-chk;            numlsq = n(m,1,kz)-2
c-debug-chk;            do j = 1,n(m,1,kz)-1
c-debug-chk;               numlsq = numlsq+n(m,j,kz)
c-debug-chk;            enddo
c-debug-chk;            difomax = -9.999999
c-debug-chk;            difomin = 9.999999
c-debug-chk;            difdmax = 0.
c-debug-chk;            numosq = 0
c-debug-chk;            num1 = 0
c-debug-chk]
c				! perform the opacity shifts computed above
            do il = 1, nr
               do k = 1, nta(il+nrdel) - ntdel
c
                  dif = co(m,mc,mo,k,il,kz) + co(m,mc,mo_m1,k,il,kz)
c-debug-chk[
c-debug-chk;                  if ( t6list(k) .gt. 0.009999 ) then
c-debug-chk;                     difcmax = max(dif,difcmax)
c-debug-chk;                     difcmin = min(dif,difcmin)
c-debug-chk;                     sumcdif = sumcdif+dif
c-debug-chk;                     sumcsq = sumcsq+dif**2
c-debug-chk;                     numcsq = numcsq+1
c-debug-chk;                     if ( dif .eq. 0. ) then
c-debug-chk;                        numsq = numsq+numlsq
c-debug-chk;                        num1 = num1+numlsq
c-debug-chk;                        diflmax = max(0.,diflmax)
c-debug-chk;                        diflmin = min(0.,diflmin)
c-debug-chk;                        difmax = max(0.,difmax)
c-debug-chk;                        difmin = min(0.,difmin)
c-debug-chk;                     endif
c-debug-chk;                  endif
c-debug-chk]
                  if ( dif .ne. 0. ) then
c
                     if ( abs(dif) .gt. 0.01 ) then
                        diffac = 10.**dif - 1.
                     else
c						! (more accurate for small dif)
                        difl = 2.302585 * dif
                        diffac = ((difl*.16666667+.5)*difl+1.)*difl
                     endif
c				! first, do shifts for all except C=O=0.0 mix:
                     ilo = 2
                     do j = 1, mo
                        if ( j .lt. n(m,1,kz) ) then
                           ihi = n(m,j,kz)
                        else if ( j .eq. mo ) then
                           ihi = n(m,1,kz) - 1
                        else
                           ihi = 0
                        endif
                        if ( ihi .gt. 0 ) then
                           do i = ilo, ihi
c					   ! If Kappa(COrich) does not exceed
c					   ! Kappa(C=O=0): then apply shift as
c					   ! delta{Log(Kappa)}, the fractional
c					   ! shift in Kappa, which may be a
c					   ! smaller shift delta'{Kappa} in the
c							 ! opacity Kappa itself
                              if ( co(m,i,j,k,il,kz) .le.
     $                             co(m,1,1,k,il,kz) ) then
                                 difl = dif
c					   ! Else Kappa(COrich) > Kappa(C=O=0):
c					   ! convert delta{Log(Kappa)} to an
c					   ! absolute shift delta{Kappa} and
c					   ! apply this (taking the log again);
c					   ! this will be a smaller fractional
c					   ! shift delta'{log(Kappa)}
                              else
                                 difl = log10( 10.**( co(m,1,1,k,il,kz)
     $                                - co(m,i,j,k,il,kz) ) * diffac
     $                                + 1. )
c-debug-chk[
c-debug-chk;                                 if ( abs(difl) .gt.
c-debug-chk;     $                                abs(dif) ) then
c-debug-chk;                                    difdmax = max(
c-debug-chk;     $                                   abs(difl)-abs(dif),
c-debug-chk;     $                                   difdmax)
c-debug-chk;                                    difomax = max(difomax,dif)
c-debug-chk;                                    difomin = min(difomin,dif)
c-debug-chk;                                    numosq = numosq+1
c-debug-chk;                                 endif
c-debug-chk]
c					! this can only happen to the extent of
c							       ! roundoff error
                                 if ( abs(difl) .gt. abs(dif) )
     $                                difl = dif
                              endif
c								 ! apply shift
                              co(m,i,j,k,il,kz) =
     $                             co(m,i,j,k,il,kz) + difl
c-debug-chk[
c-debug-chk;                              if ( t6list(k) .gt. 0.009999 ) then
c-debug-chk;                                 difmax = max(difl,difmax)
c-debug-chk;                                 difmin = min(difl,difmin)
c-debug-chk;                                 sumdif = sumdif+difl
c-debug-chk;                                 sumsq = sumsq+difl**2
c-debug-chk;                                 numsq = numsq+1
c-debug-chk;                                 if ( difl .eq. dif )
c-debug-chk;     $                                num1 = num1+1
c-debug-chk;                                 difl = (difl-dif)/dif
c-debug-chk;                                 diflmax = max(difl,diflmax)
c-debug-chk;                                 diflmin = min(difl,diflmin)
c-debug-chk;                                 sumldif = sumldif+difl
c-debug-chk;                                 sumlsq = sumlsq+difl**2
c-debug-chk;                              endif
c-debug-chk]
                           enddo
                        endif
                        ilo = 1
                     enddo
c						       ! now shift C=O=0.0 mix:
c
                     co(m,1,1,k,il,kz) = co(m,1,1,k,il,kz) + dif
c
                  endif
c
               enddo
            enddo
c-debug-chk[
c-debug-chk;            write(6,9782) m,numcsq,difcmin,difcmax,sumcdif
c-debug-chk;     $           /max(numcsq,1),sqrt(sumcsq/max(numcsq,1)),
c-debug-chk;     $           sqrt(max(sumcsq-sumcdif**2/max(numcsq,1),0.)
c-debug-chk;     $           /max(numcsq-1,1)),z
c-debug-chk; 9782       format(' '/' m=',i1,' total deltas C+O=0, T6>0.01:',
c-debug-chk;     $           i6,' [',f10.6,' ,',f10.6,' ]ave',f10.6,
c-debug-chk;     $           ' rms',f10.6,' sig',f10.6,'  for Z=',f10.7)
c-debug-chk;            write(6,8782) m,numsq,difmin,difmax,
c-debug-chk;     $           sumdif/max(numsq,1),sqrt(sumsq/max(numsq,1)),
c-debug-chk;     $           diflmin+1.,num1,diflmax+1.,
c-debug-chk;     $           sumldif/max(numsq,1)+1.,sqrt(max(sumlsq
c-debug-chk;     $           -sumldif**2/max(numsq,1),0.)/max(numsq-1,1))
c-debug-chk; 8782       format(' '/' m=',i1,' total deltas C+O>0, T6>0.01:',
c-debug-chk;     $           i6,' [',f10.6,' ,',f10.6,' ]ave',f10.6,
c-debug-chk;     $           ' rms',f10.6,'  freduce[',f10.6,' ,',i6,':',
c-debug-chk;     $           f10.6,' ]ave',f10.6,' sig',f10.6)
c-debug-chk;            if ( numosq .gt. 0 ) write(6,8783) numosq,difdmax,
c-debug-chk;     $           difomin,difomax
c-debug-chk; 8783       format(' '/i23,
c-debug-chk;     $           ' Kco > K0 cases where log(linear delta)',
c-debug-chk;     $           ' > old log delta, by up to',f13.9,
c-debug-chk;     $           ' for deltas as large as [',f13.9,' ,',f13.9,' ]')
c-debug-chk]
c					! end of loop over m-values
         enddo
c					! end of opacity shifts
      endif
c			! how many GN93hz X-values for the present value of Z
      mx_use = mx_hi
      do while ( xhi_in(mx_use-1) .gt. 0.999999 - zat )
         mx_use = mx_use - 1
      enddo
      nx_hi(kz) = mx_use
c
c  If  khighx > 0  then one should set the corrections at the 'GN93hz' X-values
c  that are not present in the 'Gz???.x??' files.
c
      if ( khighx(kz) .le. 0 ) then
c					! set flags showing high-X unavailable
         kavail_xhi = 0
         kdo_xhi = 0
c
      else
c				! set flags showing whether high-X is available
         kavail_xhi = 1
         do i = 1, kz
            kavail_xhi = min( khighx(i) , kavail_xhi )
         enddo
         if ( kavail_xhi .le. 0 ) then
            kdo_xhi = 0
         else
            kdo_xhi = kuse_xhi
         endif
c-debug-chk[
c-debug-chk;         do i = 1, 20
c-debug-chk;            chk_max(i) = -9.
c-debug-chk;            chk_min(i) = 9.
c-debug-chk;            chk_sum(i) = 0.
c-debug-chk;            chk_ssq(i) = 0.
c-debug-chk;            n_chk(i) = 0
c-debug-chk;         enddo
c-debug-chk]
c		 ! get the 'GN93hz' Z-indices (may not have been done above)
         zat = z
         kzalbe = mzal
         do while( kzalbe .gt. 1 .and.
     $        z .le. zalval(kzalbe) - small_1m6 )
            kzalbe = kzalbe - 1
         enddo
         if ( abs( zalval(kzalbe) - z ) .le. zacc(kz) ) then
            zat = zalval(kzalbe)
            kzalow = kzalbe
            nzalmo = 0
         else
            kzalow = max( 1 , kzalbe - 1 )
            nzalmo = min( kzalbe + 2 , mzal ) - kzalow
         endif
         int_hi_z = 0
c			       ! set the directory-part of the opacity filename
         if ( kope .eq. 0 ) then
            cop_sto(1) = ' '
            cop_sto(2) = ' '
         else
            cop_sto(1) = copdir(:kope)
            cop_sto(2) = copdir(:kope)
         endif
c								! get filename
         if ( klozat .eq. 0 ) then
            cop_sto(1)(kope+1:) = cfile_opalmixes(1)
            cfile_opal_used(1) = cfile_opalmixes(1)
            i = 1
         else
            cop_sto(1)(kope+1:) = cfile_opalGS98(1)
            cfile_opal_used(1) = cfile_opalGS98(1)
            i = -1
         endif
         iu = iulow
c
         if ( list_gn(i) .gt. 0 ) then
            if ( iu_list .eq. iu ) then
               write(6,4) iu_list
               iu_list = 6
            endif
            write(iu_list,2) i, cop_sto(1)(:lnblnk(cop_sto(1)))
            list_gn(i) = 0
         endif
c								! open file
         call open_chk_zip( iu, cop_sto(1), igzip,
     $        'READCO Error: hz-file (C+O=0.0,[O/Fe]=0) not found.' )
c
         line(1) = 0
         line(2) = 0
         itab_dum = 0
         khighx(kz) = 1
c							! Z > 0 & [O/Fe] > 0 ?
c
         if ( khighz_index .gt. 1 .and. kzalow + nzalmo .gt. 1 ) then
c
            khighx(kz) = 2
            if ( khighz .gt. 0 ) then
               cop_sto(2)(kope+1:) = cfile_opalmixes(khighz_index)
               cfile_opal_used(n_zmixes) =
     $              cfile_opalmixes(khighz_index)
               i = khighz_index
            else
               call chk_ofe_alt_file( khighz_index )
               if ( cfile_opalGS98(khighz_index) .ne. ' ' )
     $              cfile_opalGS98(khighz_index) =
     $                                       cfile_opal_used(n_zmixes)
               cop_sto(2)(kope+1:) = cfile_opal_used(n_zmixes)
               i = -khighz_index
            endif
            iu_ofe = iu + 1
c
            if ( list_gn(i) .gt. 0 ) then
               if ( iu_list .eq. iu_ofe ) then
                  write(6,4) iu_list
                  iu_list = 6
               endif
               write(iu_list,2) i, cop_sto(2)(:lnblnk(cop_sto(2)))
               list_gn(i) = 0
            endif
c
            call open_chk_zip( iu_ofe, cop_sto(2), igzip_ofe,
     $           'READCO Error: hz-file (C+O=0.0,[O/Fe]>0) not found.'
     $           )
            itab_dum_ofe = 0
c
         endif
c
         ix = 0
         m = 0
         io = mo
         iz_hi = nzalmo
c						! loop over 'GN93hz' X-values:
c
         do while ( ix .lt. mx_use .and. iz_hi .lt. 5 )
c							! get position in co()
            ix = ix + 1
            m = m + 1
            if ( m .gt. mx ) then
               io = io - 1
               m = 1
            endif
c				! get Z and X values to look for in 'GN93hz'
            iz_hi = nzalmo
            if ( ix .eq. mx_use ) then
               do iz = 0, nzalmo
                  zhi_look(iz+1) = zalval(kzalow+iz)
                  xhi_look(iz+1) = 1. - zhi_look(iz+1)
               enddo
            else
               do iz = 0, nzalmo
                  zhi_look(iz+1) = zalval(kzalow+iz)
                  xhi_look(iz+1) = min( xhi_in(ix) ,
     $                 1. - zhi_look(iz+1) )
               enddo
c			! check for X-column bifurcation at Z = 0.05, X = 0.95
c
               if ( ix .eq. mx_hi - 1 .and. nzalmo .eq. 3 ) then
                  if ( zat .gt. 0.03 .and. zat .lt. 0.04 ) then
                     iz_hi = 2
                     int_hi_z = 0
                  else if ( zat .gt. 0.04 .and. zat .lt. 0.05 ) then
                     iz_hi = 5
                     int_hi_z = 0
                     zhi_look(5) = zhi_look(3)
                     xhi_look(5) = xhi_look(3)
                     zhi_look(6) = zhi_look(4)
                     xhi_look(6) = xhi_look(4)
                     zhi_look(3) = zalval(kzalow)
                     xhi_look(3) = 1. - zhi_look(3)
                     zhi_look(4) = zalval(kzalow+1)
                     xhi_look(4) = 1. - zhi_look(4)
                  endif
               endif
            endif
c				! loop over the required Z-values for this X
            do iz = 0, iz_hi
c
               kat = iz + 1
c					       ! find mix; stop if not found
               i_rewind = 0
               igetzxi = 0
               ifound = mixfind(iu,1,igetzxi,i_rewind,itab_dum,
     $              line(1),zhi_look(kat),xhi_look(kat),0.0,0.0)
               if ( ifound .eq. 0 ) then
                  i_rewind = 1
                  igetzxi = 0
                  ifound = mixfind(iu,1,igetzxi,i_rewind,itab_dum,
     $                 line(1),zhi_look(kat),xhi_look(kat),0.0,0.0)
                  if ( ifound .eq. 0 ) then
                     write(6,1791) zhi_look(kat),xhi_look(kat),
     $                    0.0,0.0,cop_sto(1)(:lnblnk(cop_sto(1)))
                     stop ' STOP -- READCO: error reading hz-mix. '
                  endif
               endif
               if ( khighx(kz) .gt. 1 ) then
                  i_rewind = 0
                  igetzxi = 0
                  ifound = mixfind(iu_ofe,1,igetzxi,i_rewind,
     $                 itab_dum_ofe,line(2),
     $                 zhi_look(kat),xhi_look(kat),0.0,0.0)
                  if ( ifound .eq. 0 ) then
                     i_rewind = 1
                     igetzxi = 0
                     ifound = mixfind(iu_ofe,1,igetzxi,i_rewind,
     $                    itab_dum_ofe,line(2),
     $                    zhi_look(kat),xhi_look(kat),0.0,0.0)
                     if ( ifound .eq. 0 ) then
                        write(6,1791) zhi_look(kat),xhi_look(kat),
     $                       0.0,0.0,cop_sto(2)(:lnblnk(cop_sto(2)))
                        stop ' STOP -- READCO: error reading hz-mix. '
                     endif
                  endif
               endif
c				  ! loop over logT values, to read in opacities
               do k = 1, ntm
c					   ! read logT, & logKappa(R) for all R
                  line(1) = line(1) + 1
                  read(iu,8300) cin
 8300             format(a137)
                  read(cin,8140) flt, (cofzhi(k,il,kat),il=1,nrm)
 8140             format(f4.2,19f7.3)
c								   ! bad logT ?
                  if ( abs(flogtin(k)-flt) .gt. small_1m5 ) then
                     write(6,1734) flt, flogtin(k),
     $                    cop_sto(1)(:lnblnk(cop_sto(1))),
     $                    line(1), cin(:max(1,lnblnk(cin))),
     $                    zhi_look(kat),xhi_look(kat),0.0,0.0
                     stop ' STOP -- READCO: bad logT value. '
                  endif
c
                  il_lo = 1
                  il_hi = nrm
c							      ! logKappa(R) is:
                  do il = nrm, 1, -1
c								       ! absent
                     if ( cin(7*il-2:7*il+4) .eq. '       ' ) then
                        if ( k .le. max(nta(il),nta(0)) ) stop
     $                       ' STOP -- READCO: bad upper edge. '
                        il_hi = min( il_hi , il - 1 )
c							     ! should be absent
                     else if ( k .gt. nta(il) .and.
     $                       il .ge. nrb .and. il .le. nre ) then
                        stop ' STOP -- READCO: bad upper edge. '
c									! 9.999
                     else if ( cofzhi(k,il,kat) .gt. 9. ) then
                        if ( ix .ne. 1 ) stop
     $                       ' STOP -- READCO: bad low edge [O/Fe]=0. '
                        il_lo = max( il_lo , il + 1 )
                     endif
                  enddo
c					      ! also read [O/Fe] > 0, if needed
                  if ( khighx(kz) .gt. 1 ) then
                     line(2) = line(2) + 1
                     read(iu_ofe,8300) cin
                     read(cin,8140) flt, (coff(k,il),il=1,nrm)
                     if ( abs(flogtin(k)-flt) .gt. small_1m5 ) then
                        write(6,1734) flt, flogtin(k),
     $                       cop_sto(2)(:lnblnk(cop_sto(2))),
     $                       line(2), cin(:max(1,lnblnk(cin))),
     $                       zhi_look(kat),xhi_look(kat),0.0,0.0
                        stop ' STOP -- READCO: bad logT value. '
                     endif
                     do il = nrm, 1, -1
                        if ( cin(7*il-2:7*il+4) .eq. '       ' ) then
                           if ( k .le. max(nta(il),nta(0)) ) stop
     $                          ' STOP -- READCO: bad upper edge. '
                           il_hi = min( il_hi , il - 1 )
                        else if ( k .gt. nta(il) .and.
     $                          il .ge. nrb .and. il .le. nre ) then
                           stop ' STOP -- READCO: bad upper edge. '
                        else if ( coff(k,il) .gt. 9. ) then
                           if ( ix .ne. 1 ) stop
     $                          ' STOP -- READCO: bad low edge. '
                           il_lo = max( il_lo , il + 1 )
                        endif
                     enddo
                     do il = 1, nrm
                        cofzhi(k,il,kat) = fofe * cofzhi(k,il,kat)
     $                       + omfofe * coff(k,il)
                     enddo
                  endif
c								! for smoothing
                  if ( il_lo .gt. 1 .or. il_hi .lt. nrm ) then
                     do il = nrm, 1, -1
                        if ( il .gt. il_hi ) then
                           cofzhi(k,il,kat) = 2. * cofzhi(k-1,il,kat)
     $                          - cofzhi(k-2,il,kat)
                        else if ( il .lt. il_lo ) then
                           cofzhi(k,il,kat) = 2. * cofzhi(k,il+1,kat)
     $                          - cofzhi(k,il+2,kat)
                        endif
                     enddo
                  endif
c			! (end of loop to read opacities at all T-values):
               enddo
c			! (end of loop over required Z-values for this X):
            enddo
c							 ! actual X at Zsto(kz)
            xhi_use(ix,kz) = min( xhi_in(ix) , 1. - zat )
c							     ! Z-interpolation:
            if ( iz_hi .le. 3 ) then
c					! standard case: for all T,R:
               do k = 1, ntm
                  do il = 1, nrm
c							       ! logK at Zsto,X
                     coff(k,il) = qzinter(int_hi_z,1,zat,iz_hi,
     $                    cofzhi(k,il,1),cofzhi(k,il,2),
     $                    cofzhi(k,il,3),cofzhi(k,il,4),
     $                    zhi_look(1),zhi_look(2),zhi_look(3),
     $                    zhi_look(4),zdel)
                     int_hi_z = 1
                  enddo
               enddo
c					    ! ELSE: bifurcation:
            else
c					    ! do both X = 1-Z and X = 0.95
               xhi_use(mx_hi,kz) = 1. - zat
c						! for all T,R:
               do k = 1, ntm
                  do il = 1, nrm
c							   ! logK at Zsto,X=1-Z
                     coff(k,il) = qzinter(int_hi_z,1,zat,3,
     $                    cofzhi(k,il,3),cofzhi(k,il,4),
     $                    cofzhi(k,il,5),cofzhi(k,il,6),
     $                    zhi_look(3),zhi_look(4),zhi_look(5),
     $                    zhi_look(6),zdel)
c							  ! temp: Z=0.05,X=0.95
                     cof_tmp = qzinter(int_hi_z,2,0.05,3,
     $                    cofzhi(k,il,3),cofzhi(k,il,4),
     $                    cofzhi(k,il,5),cofzhi(k,il,6),
     $                    zhi_look(3),zhi_look(4),zhi_look(5),
     $                    zhi_look(6),zdel)
c							      ! Zsto(kz),X=0.95
                     cofzhi(k,il,1) = qzinter(int_hi_z,3,zat,2,
     $                    cofzhi(k,il,1),cofzhi(k,il,2),
     $                    cof_tmp,0.0,
     $                    zhi_look(1),zhi_look(2),0.05,0.0,zdel)
                     int_hi_z = 1
                  enddo
               enddo
c						! revise high-T,RHO extension
               call revise_hitr_for_initsmooth
c					 ! smooth hz-opacities, if init_smo > 0
               if ( init_smo .gt. 0 ) then
                  tmax = 10.
                  nset = ks81
                  RLS = alrf(1)
                  RLE = alrf(nrm)
                  nrhigh = int( dfsr(nr) * ( RLE - RLS ) + 1.00001 )
                  nrlow = 1
                  call opaltab
               endif
c					     ! store X=1-Z hz-opacity set
               do il = 1, nr
                  jl = il + nrdel
                  do k = 1, nt
                     co(mx,mc,mo_m1,k,il,kz) = coff(k+ntdel,jl)
                  enddo
               enddo
c			     ! prepare to smooth present X=0.95 hz-opacity set
               do k = 1, ntm
                  do il = 1, nrm
                     coff(k,il) = cofzhi(k,il,1)
                  enddo
               enddo
c
            endif
c						! revise high-T,RHO extension
            call revise_hitr_for_initsmooth
c					 ! smooth hz-opacities, if init_smo > 0
            if ( init_smo .gt. 0 ) then
               tmax = 10.
               nset = ks81
               RLS = alrf(1)
               RLE = alrf(nrm)
               nrhigh = int( dfsr(nr) * ( RLE - RLS ) + 1.00001 )
               nrlow = 1
               call opaltab
            endif
c					     ! store present hz-opacity set
            do il = 1, nr
               jl = il + nrdel
               do k = 1, nt
                  co(m,mc,io,k,il,kz) = coff(k+ntdel,jl)
               enddo
            enddo
c			! (end of loop over 'GN93hz' X-values):
         enddo
c						! close 'GN93hz' file(s)
         if ( khighx(kz) .gt. 1 ) then
            call close_chk_zip( iu_ofe, cop_sto(2), igzip_ofe )
         endif
         call close_chk_zip( iu, cop_sto(1), igzip )
c							! some needed values
         xxx_max = log10( 1. - zat + xdel )
         xxx_03 = log10( 0.03 + xdel )
c					! for convenience, define ALL xhi_use
         if ( mx_use .lt. mx_hi ) then
            do ix = mx_use + 1, mx_hi
               xhi_use(ix,kz) = xhi_use(mx_use,kz)
            enddo
         endif
c			! get the dlogKappa values for 'GN93hz' X-values:
c
         call quadsto( 5, xxx_hi(5), xxx_hi(2), xxx_hi(4), xxx_hi(6) )
         do ix = 7, mx_use
            if ( xhi_in(ix) .lt. 1.000001 - zat ) then
               call quadsto( ix, xxx_hi(ix),
     $                       xxx_hi(2), xxx_hi(4), xxx_hi(6) )
            else
               call quadsto( ix, log10( 1. - zat + xdel ),
     $                       xxx_hi(2), xxx_hi(4), xxx_hi(6) )
            endif
         enddo
c
         call quadsto( 1, xxx_hi(3), xxx_hi(2), xxx_hi(4), xxx_hi(6) )
         call quad4sto( 3, xxx_hi(3),
     $                  xx(2), xxx_hi(2), xxx_hi(4), xxx_hi(6) )
c
c		       ! loop over all densities and temperatures
         do il = 1, nr
c
            jl = il + nrdel
c
            do k = 1, nt
c					     ! if in high-T,R cutout: no shift:
               if ( k .gt. nta(jl) ) then
c
                  do ix = 1, mx
                     co(ix,mc,mo,k,il,kz) = 0.0
                     co(ix,mc,mo_m1,k,il,kz) = 0.0
                  enddo
c				       ! else: compute shifts for all X-values:
               else
c								   ! bad logK ?
                  if ( max( co(3,1,1,k,il,kz) , co(4,1,1,k,il,kz) ,
     $                 co(5,1,1,k,il,kz) ) .gt. 9.0 ) stop
     $                 ' STOP -- Error: bad co(3:5,1,1,*,*) cannot be '
c-debug-chk[
c-debug-chk;                  if ( k+ntdel .gt. 5 ) then
c-debug-chk;                     cof_del = co(2,mc,mo,k,il,kz)
c-debug-chk;     $                       - co(3,1,1,k,il,kz)
c-debug-chk;                     n_chk(12) = n_chk(12) + 1
c-debug-chk;                     chk_max(12) = max( chk_max(12) , cof_del )
c-debug-chk;                     chk_min(12) = min( chk_min(12) , cof_del )
c-debug-chk;                     chk_sum(12) = chk_sum(12) + cof_del
c-debug-chk;                     chk_ssq(12) = chk_ssq(12) + cof_del**2
c-debug-chk;                     cof_del = co(4,mc,mo,k,il,kz)
c-debug-chk;     $                       - co(4,1,1,k,il,kz)
c-debug-chk;                     n_chk(14) = n_chk(14) + 1
c-debug-chk;                     chk_max(14) = max( chk_max(14) , cof_del )
c-debug-chk;                     chk_min(14) = min( chk_min(14) , cof_del )
c-debug-chk;                     chk_sum(14) = chk_sum(14) + cof_del
c-debug-chk;                     chk_ssq(14) = chk_ssq(14) + cof_del**2
c-debug-chk;                     cof_del = co(1,mc,mo_m1,k,il,kz)
c-debug-chk;     $                    - co(5,1,1,k,il,kz)
c-debug-chk;                     n_chk(16) = n_chk(16) + 1
c-debug-chk;                     chk_max(16) = max( chk_max(16) , cof_del )
c-debug-chk;                     chk_min(16) = min( chk_min(16) , cof_del )
c-debug-chk;                     chk_sum(16) = chk_sum(16) + cof_del
c-debug-chk;                     chk_ssq(16) = chk_ssq(16) + cof_del**2
c-debug-chk;                  endif
c-debug-chk]
c							! if no logK at X=0.03:
                  if ( co(2,1,1,k,il,kz) .gt. 9.0 .or.
     $                 k+ntdel .lt. ntax03(nr+nrdel) ) then
c							      ! 3-X-pt at X=0.2
                     cof_tmp = quadget( 1, co(2,mc,mo,k,il,kz),
     $                    co(4,mc,mo,k,il,kz), co(1,mc,mo_m1,k,il,kz) )
                     co(3,mc,mo,k,il,kz) = co(3,mc,mo,k,il,kz)
     $                    - cof_tmp
c-debug-chk[
c-debug-chk;                     cof_o = quadget(1,co(3,1,1,k,il,kz),
c-debug-chk;     $                    co(4,1,1,k,il,kz),co(5,1,1,k,il,kz))
c-debug-chk;                     cof_del = cof_tmp - cof_o
c-debug-chk]
c					   ! else: if logK available at X=0.03:
                  else
c-debug-chk[
c-debug-chk;                     if ( k+ntdel .gt. 5 .and.
c-debug-chk;     $                    k+ntdel .lt. ntax0(nr+nrdel) .and.
c-debug-chk;     $                    co(1,1,1,k,il,kz) .lt. 9. ) then
c-debug-chk;                        cof_del = co(1,mc,mo,k,il,kz)
c-debug-chk;     $                       - co(1,1,1,k,il,kz)
c-debug-chk;                        n_chk(11) = n_chk(11) + 1
c-debug-chk;                        chk_max(11) = max( chk_max(11) , cof_del )
c-debug-chk;                        chk_min(11) = min( chk_min(11) , cof_del )
c-debug-chk;                        chk_sum(11) = chk_sum(11) + cof_del
c-debug-chk;                        chk_ssq(11) = chk_ssq(11) + cof_del**2
c-debug-chk;                     endif
c-debug-chk]
c							      ! 4-X-pt at X=0.2
c
                     cof_tmp = quad4get( 3, co(2,1,1,k,il,kz),
     $                                   co(2,mc,mo,k,il,kz),
     $                                   co(4,mc,mo,k,il,kz),
     $                                   co(1,mc,mo_m1,k,il,kz) )
                     co(3,mc,mo,k,il,kz) = co(3,mc,mo,k,il,kz)
     $                    - cof_tmp
c-debug-chk[
c-debug-chk;                     cof_o = quad4get(3,co(2,1,1,k,il,kz),
c-debug-chk;     $                    co(3,1,1,k,il,kz),co(4,1,1,k,il,kz),
c-debug-chk;     $                    co(5,1,1,k,il,kz))
c-debug-chk;                     cof_del = cof_tmp - cof_o
c-debug-chk]
                  endif
c-debug-chk[
c-debug-chk;                  if ( k+ntdel .gt. 5 ) then
c-debug-chk;                     n_chk(13) = n_chk(13) + 1
c-debug-chk;                     chk_max(13) = max( chk_max(13) , cof_del )
c-debug-chk;                     chk_min(13) = min( chk_min(13) , cof_del )
c-debug-chk;                     chk_sum(13) = chk_sum(13) + cof_del
c-debug-chk;                     chk_ssq(13) = chk_ssq(13) + cof_del**2
c-debug-chk;                  endif
c-debug-chk]
c							! 3-X-pt dlogK at X=0.5
                  cof_tmp = quadget( 5, co(2,mc,mo,k,il,kz),
     $                 co(4,mc,mo,k,il,kz), co(1,mc,mo_m1,k,il,kz) )
                  co(5,mc,mo,k,il,kz) = co(5,mc,mo,k,il,kz) - cof_tmp
c-debug-chk[
c-debug-chk;                  if ( k+ntdel .gt. 5 ) then
c-debug-chk;                     cof_o = quadget(5,co(3,1,1,k,il,kz),
c-debug-chk;     $                    co(4,1,1,k,il,kz),co(5,1,1,k,il,kz))
c-debug-chk;                     cof_del = cof_tmp - cof_o
c-debug-chk;                     n_chk(15) = n_chk(15) + 1
c-debug-chk;                     chk_max(15) = max( chk_max(15) , cof_del )
c-debug-chk;                     chk_min(15) = min( chk_min(15) , cof_del )
c-debug-chk;                     chk_sum(15) = chk_sum(15) + cof_del
c-debug-chk;                     chk_ssq(15) = chk_ssq(15) + cof_del**2
c-debug-chk;                  endif
c-debug-chk]
c				     ! 3-X-pt dlogK at X = 0.8, 0.9, 0.95, 1-Z:
                  do ix = 7, mx_use
                     cof_tmp = quadget( ix, co(2,mc,mo,k,il,kz),
     $                    co(4,mc,mo,k,il,kz), co(1,mc,mo_m1,k,il,kz) )
                     co(ix-5,mc,mo_m1,k,il,kz) =
     $                    co(ix-5,mc,mo_m1,k,il,kz) - cof_tmp
c-debug-chk[
c-debug-chk;                     if ( k+ntdel .gt. 5 ) then
c-debug-chk;                        cof_o = quadget(ix,co(3,1,1,k,il,kz),
c-debug-chk;     $                       co(4,1,1,k,il,kz),co(5,1,1,k,il,kz))
c-debug-chk;                        cof_del = cof_tmp - cof_o
c-debug-chk;                        n_chk(ix+10) = n_chk(ix+10) + 1
c-debug-chk;                        chk_max(ix+10) = max( chk_max(ix+10) ,
c-debug-chk;     $                       cof_del )
c-debug-chk;                        chk_min(ix+10) = min( chk_min(ix+10) ,
c-debug-chk;     $                       cof_del )
c-debug-chk;                        chk_sum(ix+10) = chk_sum(ix+10) + cof_del
c-debug-chk;                        chk_ssq(ix+10) = chk_ssq(ix+10)
c-debug-chk;     $                       + cof_del**2
c-debug-chk;                     endif
c-debug-chk]
                  enddo
c				 ! dlogK=0.0 at X = 0.03, 0.1, 0.35, 0.7: these
c					   ! are available in 'Gz???.x??' files
                  co(1,mc,mo,k,il,kz) = 0.0
                  co(2,mc,mo,k,il,kz) = 0.0
                  co(4,mc,mo,k,il,kz) = 0.0
                  co(1,mc,mo_m1,k,il,kz) = 0.0
c-debug-chk[
c-debug-chk;                  if ( k+ntdel .gt. 5 ) then
c-debug-chk;                     m = 0
c-debug-chk;                     io = mo
c-debug-chk;                     do ix = 1, mx_use
c-debug-chk;                        m = m + 1
c-debug-chk;                        if ( m .gt. 5 ) then
c-debug-chk;                           m = 1
c-debug-chk;                           io = io - 1
c-debug-chk;                        endif
c-debug-chk;                        cof_del = co(m,mc,io,k,il,kz)
c-debug-chk;                        n_chk(ix) = n_chk(ix) + 1
c-debug-chk;                        chk_max(ix) = max( chk_max(ix) , cof_del )
c-debug-chk;                        chk_min(ix) = min( chk_min(ix) , cof_del )
c-debug-chk;                        chk_sum(ix) = chk_sum(ix) + cof_del
c-debug-chk;                        chk_ssq(ix) = chk_ssq(ix) + cof_del**2
c-debug-chk;                     enddo
c-debug-chk;                  endif
c-debug-chk]
               endif
            enddo
         enddo
c-debug-chk[
c-debug-chk;         write(6,6273) kz, zat, ofebrack, mx_use, iz_hi, kzalow,
c-debug-chk;     $        (n_chk(ix),ix=1,20),
c-debug-chk;     $        (chk_min(ix),ix=1,20), (chk_max(ix),ix=1,20),
c-debug-chk;     $        (chk_sum(ix)/max(n_chk(ix),1),ix=1,20),
c-debug-chk;     $        (sqrt(chk_ssq(ix)/max(n_chk(ix),1)),ix=1,20)
c-debug-chk; 6273    format(' '/' kz =',i3,'  Z =',f10.6,'  [O/Fe] =',f6.3,
c-debug-chk;     $        '  mx_use =',i3,'  iz_hi =',i2,'  kzalow =',i3,
c-debug-chk;     $        ' : X_hi deltas:'/' '/' N',20i10/' min',20f10.6/
c-debug-chk;     $        ' max',20f10.6/' ave',20f10.6/' rms',20f10.6/' ')
c-debug-chk]
c			      ! remember to set X_1 = 0.03 for 'GN93hz' shifts
         xhi_use(1,kz) = 0.03
c
      endif
c
c  If required, read in CNO- and/or user-interpolation opacity tables
c
      if ( khighz_cno .eq. 0 ) then
c
         kavail_cno = 0
         kavail_user = 0
c
      else
c
         kdel = 1
         if ( khighz_cno .ge. 2 ) then
            khi = n_totmix
            if ( khighz_cno .eq. 2 ) then
               kdel = khi - n_cnobeg
               kavail_cno = 0
            endif
         else
            khi = n_totmix - 1
            kavail_user = 0
         endif
c		 ! get the 'GN93hz' Z-indices (may not have been done above)
         zat = z
         kzalbe = mzal
         do while( kzalbe .gt. 1 .and.
     $        z .le. zalval(kzalbe) - small_1m6 )
            kzalbe = kzalbe - 1
         enddo
         if ( abs( zalval(kzalbe) - z ) .le. zacc(kz) ) then
            zat = zalval(kzalbe)
            kzalow = kzalbe
            nzalmo = 0
         else
            kzalow = max( 1 , kzalbe - 1 )
            nzalmo = min( kzalbe + 2 , mzal ) - kzalow
         endif
         int_hi_z = 0
c			       ! set the directory-part of the opacity filename
         if ( kope .eq. 0 ) then
            cop_sto(1) = ' '
            cop_sto(2) = ' '
         else
            cop_sto(1) = copdir(:kope)
            cop_sto(2) = copdir(:kope)
         endif
c								! get filename
         if ( cfile_opalGS98(n_cnobeg) .ne. ' ' ) then
            cop_sto(1)(kope+1:) = cfile_opalGS98(n_cnobeg)
            cfile_opal_used(n_cnobeg) = cfile_opalGS98(n_cnobeg)
            i = n_cnobeg
         else if ( khighz .gt. 0 ) then
            cop_sto(1)(kope+1:) = cfile_opalmixes(1)
            cfile_opal_used(n_cnobeg) = cfile_opalmixes(1)
            i = 1
         else
            cop_sto(1)(kope+1:) = cfile_opalGS98(1)
            cfile_opal_used(n_cnobeg) = cfile_opalGS98(1)
            i = -1
         endif
         last = lnblnk( cop_sto(1) )
         iu = iulow
c
         if ( list_gn(i) .gt. 0 ) then
            if ( iu_list .eq. iu ) then
               write(6,4) iu_list
               iu_list = 6
            endif
            write(iu_list,2) i, cop_sto(1)(:last)
            list_gn(i) = 0
         endif
c		    ! get indices where X=1-Z 'GN93hz' opacities will be stored
c
         call index_co_deltas( 5, mx_hi, kkx, kkc, kko )
c							 ! loop over CNO-files
         do kfil = n_cnobeg, khi, kdel
c
            iset = kfil - n_zmixes
            if ( iset .eq. 1 ) iset = 5
c
            if ( cfile_opalGS98(kfil) .ne. ' ' ) then
               cop_sto(2)(kope+1:) = cfile_opalGS98(kfil)
               cfile_opal_used(kfil) = cfile_opalGS98(kfil)
            else
               cop_sto(2) = cop_sto(1)(1:last) // cdef_CNO_ext(kfil)
               cfile_opal_used(kfil) = cop_sto(1)(kope+1:last) //
     $              cdef_CNO_ext(kfil)
            endif
c
            if ( list_gn(kfil) .gt. 0 ) then
               if ( iu_list .eq. iu ) then
                  write(6,4) iu_list
                  iu_list = 6
               endif
               write(iu_list,2) kfil, cop_sto(2)(:lnblnk(cop_sto(2)))
               list_gn(kfil) = 0
            endif
c								! open file
            call open_chk_zip( iu, cop_sto(2), igzip,
     $           'READCO Error: hz-file (C+O=0.0,intCNO) not found.' )
c
            line(2) = 0
            itab_dum = 0
            ix = 0
            iz_hi = nzalmo
            igetzxi = 1
c								! X=1-Z indices
            call index_co_deltas( iset, mx_hi, jjx, jjc, jjo )
c
c						! loop over 'GN93hz' X-values:
c
            do while ( ix .lt. mx_use .and. iz_hi .lt. 5 )
c							  ! get indices in co()
               ix = ix + 1
               call index_co_deltas( iset, ix, jx, jc, jo )
c							    ! & stored 'GN93hz'
               call index_co_deltas( 5, ix, kx, kc, ko )
c
c				! get Z and X values to look for in CNO-file
               iz_hi = nzalmo
               if ( ix .eq. mx_use ) then
                  do iz = 0, nzalmo
                     zhi_look(iz+1) = zalval(kzalow+iz)
                     xhi_look(iz+1) = 1. - zhi_look(iz+1)
                  enddo
               else
                  do iz = 0, nzalmo
                     zhi_look(iz+1) = zalval(kzalow+iz)
                     xhi_look(iz+1) = min( xhi_in(ix) ,
     $                    1. - zhi_look(iz+1) )
                  enddo
c			! check for X-column bifurcation at Z = 0.05, X = 0.95
c
                  if ( ix .eq. mx_hi - 1 .and. nzalmo .eq. 3 ) then
                     if ( zat .gt. 0.03 .and. zat .lt. 0.04 ) then
                        iz_hi = 2
                        int_hi_z = 0
                     else if ( zat .gt. 0.04 .and. zat .lt. 0.05 ) then
                        iz_hi = 5
                        int_hi_z = 0
                        zhi_look(5) = zhi_look(3)
                        xhi_look(5) = xhi_look(3)
                        zhi_look(6) = zhi_look(4)
                        xhi_look(6) = xhi_look(4)
                        zhi_look(3) = zalval(kzalow)
                        xhi_look(3) = 1. - zhi_look(3)
                        zhi_look(4) = zalval(kzalow+1)
                        xhi_look(4) = 1. - zhi_look(4)
                     endif
                  endif
               endif
c				! loop over the required Z-values for this X
               do iz = 0, iz_hi
c
                  kat = iz + 1
c					       ! find mix; stop if not found
                  i_rewind = 0
                  ifound = mixfind(iu,-kfil,igetzxi,i_rewind,
     $                 itab_dum,line(2),
     $                 zhi_look(kat),xhi_look(kat),0.0,0.0)
                  igetzxi = 0
                  if ( ifound .eq. 0 ) then
                     i_rewind = 1
                     ifound = mixfind(iu,-kfil,igetzxi,i_rewind,
     $                    itab_dum,line(2),
     $                    zhi_look(kat),xhi_look(kat),0.0,0.0)
                     igetzxi = 0
                     if ( ifound .eq. 0 ) then
                        write(6,1791) zhi_look(kat),xhi_look(kat),
     $                       0.0,0.0,cop_sto(2)(:last)
                        stop ' STOP -- READCO: error reading CNO-mix. '
                     endif
                  endif
c				  ! loop over logT values, to read in opacities
                  do k = 1, ntm
c					   ! read logT, & logKappa(R) for all R
                     line(2) = line(2) + 1
                     read(iu,'(a137)') cin
                     read(cin,'(f4.2,19f7.3)') flt,
     $                    (cofzhi(k,il,kat),il=1,nrm)
c								   ! bad logT ?
                     if ( abs(flogtin(k)-flt) .gt. small_1m5 ) then
                        write(6,1734) flt, flogtin(k),
     $                       cop_sto(2)(:lnblnk(cop_sto(2))),
     $                       line(2), cin(:max(1,lnblnk(cin))),
     $                       zhi_look(kat),xhi_look(kat),0.0,0.0
                        stop ' STOP -- READCO: bad logT value. '
                     endif
c
                     il_lo = 1
                     il_hi = nrm
c							      ! logKappa(R) is:
                     do il = nrm, 1, -1
c								       ! absent
                        if ( cin(7*il-2:7*il+4) .eq. '       ' ) then
                           il_hi = min( il_hi , il - 1 )
c									! 9.999
                        else if ( cofzhi(k,il,kat) .gt. 9. ) then
                           il_lo = max( il_lo , il + 1 )
                        endif
                     enddo
c								  ! for deltas
                     if ( il_lo .gt. 1 .or. il_hi .lt. nrm ) then
                        do il = nrm, 1, -1
                           if ( il .gt. il_hi ) then
                              cofzhi(k,il,kat) = 2. * cofzhi(k-1,il,kat)
     $                             - cofzhi(k-2,il,kat)
                           else if ( il .lt. il_lo ) then
                              cofzhi(k,il,kat) = 2. * cofzhi(k,il+1,kat)
     $                             - cofzhi(k,il+2,kat)
                           endif
                        enddo
                     endif
c			   ! (end of loop to read opacities at all T-values):
                  enddo
c			! (end of loop over required Z-values for this X):
               enddo
c							      ! actual X at Zat
               xcno_use(ix,kz) = min( xhi_in(ix) , 1. - zat )
c							     ! Z-interpolation:
               if ( iz_hi .le. 3 ) then
c					! standard case: for all T,R:
                  do k = 1, ntm
                     do il = 1, nrm
c							       ! logK at Zsto,X
                        coff(k,il) = qzinter(int_hi_z,1,zat,iz_hi,
     $                       cofzhi(k,il,1),cofzhi(k,il,2),
     $                       cofzhi(k,il,3),cofzhi(k,il,4),
     $                       zhi_look(1),zhi_look(2),zhi_look(3),
     $                       zhi_look(4),zdel)
                        int_hi_z = 1
                     enddo
                  enddo
c					    ! ELSE: bifurcation:
               else
c					        ! do both X = 1-Z and X = 0.95
                  xcno_use(mx_hi,kz) = 1. - zat
c						! for all T,R:
                  do k = 1, ntm
                     do il = 1, nrm
c							   ! logK at Zsto,X=1-Z
                        coff(k,il) = qzinter(int_hi_z,1,zat,3,
     $                       cofzhi(k,il,3),cofzhi(k,il,4),
     $                       cofzhi(k,il,5),cofzhi(k,il,6),
     $                       zhi_look(3),zhi_look(4),zhi_look(5),
     $                       zhi_look(6),zdel)
c							  ! temp: Z=0.05,X=0.95
                        cof_tmp = qzinter(int_hi_z,2,0.05,3,
     $                       cofzhi(k,il,3),cofzhi(k,il,4),
     $                       cofzhi(k,il,5),cofzhi(k,il,6),
     $                       zhi_look(3),zhi_look(4),zhi_look(5),
     $                       zhi_look(6),zdel)
c							      ! Zsto(kz),X=0.95
                        cofzhi(k,il,1) = qzinter(int_hi_z,3,zat,2,
     $                       cofzhi(k,il,1),cofzhi(k,il,2),
     $                       cof_tmp,0.0,
     $                       zhi_look(1),zhi_look(2),0.05,0.0,zdel)
                        int_hi_z = 1
                     enddo
                  enddo
c						! revise high-T,RHO extension
                  call revise_hitr_for_initsmooth
c					     ! smooth CNO-opac, if init_smo > 1
                  if ( init_smo .ge. 2 ) then
                     tmax = 10.
                     nset = ks81
                     RLS = alrf(1)
                     RLE = alrf(nrm)
                     nrhigh = int( dfsr(nr) * ( RLE - RLS ) + 1.00001 )
                     nrlow = 1
                     call opaltab
                  endif
c						 ! store X=1-Z hz-opacity set
                  if ( kfil .eq. n_cnobeg ) then
                     do il = 1, nr
                        jl = il + nrdel
                        do k = 1, nt
                           co(jjx,jjc,jjo,k,il,kz) = coff(k+ntdel,jl)
                        enddo
                     enddo
                  else
                     do il = 1, nr
                        jl = il + nrdel
                        do k = 1, nt
                           co(jjx,jjc,jjo,k,il,kz) = coff(k+ntdel,jl)
     $                          - co(kkx,kkc,kko,k,il,kz)
                        enddo
                     enddo
                  endif
c				! get present X=0.95 hz-opacity set
                  do k = 1, ntm
                     do il = 1, nrm
                        coff(k,il) = cofzhi(k,il,1)
                     enddo
                  enddo
c
               endif
c						! revise high-T,RHO extension
               call revise_hitr_for_initsmooth
c					   ! smooth CNO-opac, if init_smo > 1
               if ( init_smo .ge. 2 ) then
                  tmax = 10.
                  nset = ks81
                  RLS = alrf(1)
                  RLE = alrf(nrm)
                  nrhigh = int( dfsr(nr) * ( RLE - RLS ) + 1.00001 )
                  nrlow = 1
                  call opaltab
               endif
c					      ! store present hz-opacity set
               if ( kfil .eq. n_cnobeg ) then
                  do il = 1, nr
                     jl = il + nrdel
                     do k = 1, nt
c-debug[
c-debug;                        if ( co(jx,jc,jo,k,il,kz) .lt. badlogklim )
c-debug;     $                       stop ' STOP -- Error: CNO overwrite. '
c-debug]
                        co(jx,jc,jo,k,il,kz) = coff(k+ntdel,jl)
                     enddo
                  enddo
               else
                  do il = 1, nr
                     jl = il + nrdel
                     do k = 1, nt
c-debug[
c-debug;                        if ( kfil .lt. n_totmix .and.
c-debug;     $                       co(jx,jc,jo,k,il,kz) .lt. badlogklim )
c-debug;     $                       stop ' STOP -- Error: CNO overwrite. '
c-debug]
                        co(jx,jc,jo,k,il,kz) = coff(k+ntdel,jl)
     $                       - co(kx,kc,ko,k,il,kz)
                     enddo
                  enddo
               endif
c			! (end of loop over 'GN93hz' X-values):
            enddo
c							! close CNO-file
            call close_chk_zip( iu, cop_sto(2), igzip )
c							! (end CNO-file loop):
         enddo
c
      endif
c			! restore old m value (this should not be necessary)
      m = mstore
c			! and return.
      return
      end
c
c******************************************************************************
c
      subroutine revise_hitr_for_initsmooth
c     =====================================
c
c  revise high-T,RHO extension for smoothing and extrapolation
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common/b_opal_z/ nta(0:nrm_p1),ntax0(0:nrm),
     $     ntax03(0:nrm), sltlo, slthi, dltlo_inv, dlthi_inv,
     $     slrlo, slrhi, dlrlo_inv, dlrhi_inv, init_trvals
      save /b_opal_z/
c
      common/alink_opal_z/ NTEMP,NSM,nrlow,nrhigh,RLE,t6arr(100),
     $     coff(100,nrm)
      save /alink_opal_z/
c
      k = nta(1)
c
      il = nrm
      do while ( il .gt. 1 .and. nta(il) .lt. k )
         il = il - 1
      enddo
c						! requires min logR > -2.0
      if ( nta(il) .eq. k ) then
c
         if ( il .eq. 1 ) then
            tmp = 0.0
         else
            tmp = coff(k,il) - coff(k,il-1)
            if ( il .gt. 2 ) tmp = 2.0 * tmp
     $           - ( coff(k,il-1) - coff(k,il-2) )
         endif
c
         tmp = max( -0.1 , min( 0.1 , tmp ) )
c
         do i = il + 1, nrm
            coff(k,i) = coff(k,i-1) + tmp
            if ( nta(i) .eq. k - 1 ) coff(k,i) =
     $           min( coff(k,i) , coff(k-1,i) )
         enddo
c
         i = max( il - 7 , 1 )
         d_lim = coff(k,i) - coff(k-1,i)
         do while ( i .lt. nrm )
            i = i + 1
            if ( nta(i) .ge. k - 1 ) then
               d_lim = max( d_lim ,
     $              coff(k,i) - coff(k-1,i) )
               il = i
            endif
         enddo
c
         k = k - 1
         if ( il .eq. 1 ) then
            tmp = 0.0
         else
            tmp = coff(k,il) - coff(k,il-1)
         endif
c
         do i = il + 1, nrm
c
            coff(k,i) = max( coff(k,i-1) + tmp ,
     $           coff(k+1,i) - d_lim )
c
            do j = k - 1, nta(i) + 1, -1
               fac = ( flogtin(k) - flogtin(j) )
     $              / ( flogtin(k) - flogtin(nta(i)) )
               coff(j,i) = max( coff(j+1,i) ,
     $              ( 2.0 * coff(j,i-1) - coff(j,max(1,i-2))
     $              + ( 1. - fac ) * coff(k,i)
     $              + fac * coff(nta(i),i) ) * 0.5 )
            enddo
c
         enddo
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine cointsmo(xxc,xxo,kz)
c     ===============================
c
c  The purpose of COINTSMO is to interpolate smoothly in C and O abundances.
c
c  This subroutine yields smoother opacities than alternate COINTERP below.
c
c  Note that the quadratic-interpolation function quad has been replaced with
c  the function qchk here; the latter function checks whether two of the
c  interpolation points are nearly coincident (which would magnify the effect
c  of any uncertainties in the tabulated opacities), and uses something more
c  nearly linear if so.  This is sometimes necessary to prevent wildly wrong
c  opacity values for certain Z-values above Z=0.03, and also in some cases to
c  allow linear interpolation along lines where only two opacity values exist.
c  For the special case where C or O is slightly negative (slight depletion in
c  C or O), the function qchk does a linear extrapolation using a combination
c  of the lowest three C or O gridpoints.
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      common/bb_opal_z/ xodp,xcdp,xxco,cxx,oxx,
     $     l1,l2,l3,l4,k1,k2,k3,k4,ip,iq(4),kzf,kzg,kzh,kzf2
      save /bb_opal_z/
c-debug[
c-debug;      common/outdeb/ ioudeb,oudebl,koudeb
c-debug]
c___
      dimension j2m(mc),j3m(mc),j4m(mc)
c===
      is = 0
c							 ! IF C+O = 0: trivial:
      if ( max( abs(xxc) , abs(xxo) ) .lt. small_1m6 ) then
c
         do it = k1,k1+ip
            do ir = l1,l1+iq(it-k1+1)
               opl(it,ir,kz) = co(m,1,1,it,ir,kz)
            enddo
         enddo
c			! we are done: return
         return
c
      endif
c							 ! ELSE: if C,O not 0:
      i3 = min( indx(min(int(100.*max(xxc,0.)),100)+1) + 1 , nc )
      i4 = min( i3+1 , nc )
      i1 = max( i3-2 , 1 )
      i2 = i3-1
      j3 = min( indx(min(int(100.*max(xxo,0.)),100)+1) + 1 , no )
      j4 = min( j3+1 , no )
      j1 = max( j3-2 , 1 )
      j2 = j3-1
c
      n2 = i1+1
      n3 = i1+2
      m2 = j1+1
      m3 = j1+2
c			! these initializations just prevent compiler warnings:
      cfac = 0.0
      ofac = 0.0
      afac = 0.0
      bfac = 0.0
      ib1 = 1
      ib2 = 2
      ib3 = 3
      ib4 = 4
      j4n = 0
      j2n = 4
      nb2 = 2
      nb3 = 3
      jb1 = 1
      jb2 = 2
      jb3 = 3
      jb4 = 4
      mb2 = 2
      mb3 = 3
c			      ! if C > or = O: then j3 < no unless m=5, C=O=0.1
      if ( xxc .ge. xxo ) then
c
         if ( i4 .gt. n3 ) cfac = (cxx-cx(i2))/(cx(i3)-cx(i2))
c							       ! if O = 0.0:
         if ( abs(xxo) .lt. small_1m6 ) then
c
            if ( i4 .le. n3 ) then
               call qchksto( 1, cxx,
     $                       cx(i1), cx(n2), min(cx(n3),cxd(1)) )
               do it = k1, k1 + ip
                  do ir = l1, l1 + iq(it-k1+1)
                     opl(it,ir,kz) = qchkget( 1, co(m,i1,1,it,ir,kz),
     $                    co(m,n2,1,it,ir,kz), co(m,n3,1,it,ir,kz) )
c-debug[
c-debug;                     if ( ioudeb .gt. 7 .or. .not.
c-debug;     $                    abs(opl(it,ir,kz)) .le. oudebl ) then
c-debug;                        if ( ioudeb .le. 5 .or. ( it .eq. k1 .and.
c-debug;     $                       ir .eq. l1 ) ) write(6,*) ' '
c-debug;                        write(6,9414) m,it,ir,kz,'O=0','C',cxx,'K',
c-debug;     $                       opl(it,ir,kz),0.,(j,1,min(cx(j),cxd(1)),
c-debug;     $                       co(m,j,1,it,ir,kz),j=i1,n3)
c-debug; 9414                   format(' COINTSMO(x',i1,',t',i2.2,',r',i2.2,
c-debug;     $                       ',z',i2.2,')',a3,' ',a1,f11.7,' : ',a1,
c-debug;     $                       ' =',g15.7,' <--(f=',f10.7,
c-debug;     $                       ') kc,ko,CorO,K:',4(i3,i2,2f11.7))
c-debug;                     endif
c-debug]
                  enddo
               enddo
            else
               call quadsto( 1, cxx, cx(i1), cx(i2), cx(i3) )
               call qchksto( 2, cxx,
     $                       cx(i2), cx(i3), min(cx(i4),cxd(1)) )
               do it = k1, k1 + ip
                  do ir = l1, l1 + iq(it-k1+1)
                     opl(it,ir,kz) = ( 1. - cfac ) * quadget( 1,
     $                    co(m,i1,1,it,ir,kz), co(m,i2,1,it,ir,kz),
     $                    co(m,i3,1,it,ir,kz) )
     $                    + cfac * qchkget( 2, co(m,i2,1,it,ir,kz),
     $                    co(m,i3,1,it,ir,kz), co(m,i4,1,it,ir,kz) )
c-debug[
c-debug;                     if ( ioudeb .gt. 7 .or. .not.
c-debug;     $                    abs(opl(it,ir,kz)) .le. oudebl ) then
c-debug;                        if ( ioudeb .le. 5 .or. ( it .eq. k1 .and.
c-debug;     $                       ir .eq. l1 ) ) write(6,*) ' '
c-debug;                        write(6,9414) m,it,ir,kz,'O=0','C',cxx,'K',
c-debug;     $                       opl(it,ir,kz),cfac,(j,1,min(cx(j),cxd(1)),
c-debug;     $                       co(m,j,1,it,ir,kz),j=i1,i4)
c-debug;                     endif
c-debug]
                  enddo
               enddo
            endif
c			! we are done: return
            return
c
         endif
c						! else if C > O, and O not 0.0
         icomax = -1
         if ( xxco .gt. xcd(1) - small_1m6 ) icomax = 1
         if ( j1 .lt. j2 ) ofac = (oxx-ox(j2))/(ox(j3)-ox(j2))
         if ( icomax .lt. 0 ) then
            i4 = min( i4 , n(m,j2,kz) )
            cof(i1,1) = cx(i1)
            cof(i2,1) = cx(i2)
            cof(i3,1) = cx(i3)
            cof(i4,1) = cx(i4)
            if ( i3 .ge. n(m,j3,kz) .and. xxo .ge. xod(i3) ) then
               i4 = i3
               icomax = 0
               cof(i4,1) = log10(zzz(kz)+xcdp)
            else if ( i4 .ge. n(m,j3,kz) ) then
               icomax = 0
               cof(i4,1) = log10(zzz(kz)+xcdp)
            endif
            do i = i1,i4
               j2m(i) = m2
               if ( m2 .ge. n(m,i,kz) ) j2m(i) = mo
               j3m(i) = m3
               if ( m3 .ge. n(m,i,kz) ) j3m(i) = mo
               j4m(i) = j4
               if ( j4 .ge. n(m,i,kz) ) j4m(i) = mo
            enddo
         endif
         ihi = i4
         if ( icomax .ge. 0 ) then
            ihi = i4-1
            if ( j4 .lt. no ) then
               j2m(i4) = n(m,j4,kz)
               j4m(i4) = j4
               cof(4,4) = ox(j4)
            else
               j2m(i4) = max( n(m,j4-1,kz) - 2 , 1 )
               j4m(i4) = mo
               cof(4,4) = oxd(j2m(i4))
            endif
            j4n = 0
            if ( xxo .gt. xod(nc-1) + small_1m6 ) then
               if ( icomax .gt. 0 ) cof(i4,1) = log10(zzz(kz)+xcdp)
               bfac = min( 0.5 , ( xxo - xod(nc-1) )
     $              / max( xod(1)-2.*xod(nc-1) , small_1m6 ) )
               ib3 = min( indx(int(100.*max(xcdp,0.))+1) + 1 , nc )
               ib4 = min( ib3 + 1 , nc )
               ib1 = max( ib3 - 2 , 1 )
               ib2 = ib3-1
               nb2 = ib1+1
               nb3 = ib1+2
               if ( ib4 .gt. nb3 )
     $              afac = (cof(i4,1)-cx(ib2))/(cx(ib3)-cx(ib2))
               if ( ib4 .lt. nc ) then
                  j2n = ib4
                  j4n = mo
                  cof(5,5) = cx(ib4)
               else
                  j4n = max( n(m,ib4-1,kz) - 2 , 1 )
                  j2n = n(m,j4n,kz)
                  cof(5,5) = cxd(j4n)
               endif
            endif
         endif
c
         if ( icomax .ge. 0 ) then
            if ( j4 .le. m3 ) then
               call qchksto( 13, oxx, ox(j1), ox(m2), cof(4,4) )
            else
               call quadsto( 13, oxx, ox(j1), ox(j2), ox(j3) )
               call qchksto( 14, oxx, ox(j2), ox(j3), cof(4,4) )
            endif
            if ( j4n .gt. 0 ) then
               if ( ib4 .le. nb3 ) then
                  call qchksto( 15, cof(i4,1),
     $                          cx(ib1), cx(nb2), cof(5,5) )
               else
                  call quadsto( 15, cof(i4,1),
     $                          cx(ib1), cx(ib2), cx(ib3) )
                  call qchksto( 16, cof(i4,1),
     $                          cx(ib2), cx(ib3), cof(5,5) )
               endif
            endif
         endif
         if ( icomax .le. 0 ) then
            iw = 0
            is = 0
            do i = i1, ihi
               iw = iw + 1
               if ( j4m(i) .le. j3m(i) ) then
                  call qchksto( iw, oxx, ox(j1), min(ox(m2),oxd(i)),
     $                          min(ox(m3),oxd(i)) )
               else
                  if ( is .eq. 0 )
     $                 call quadsto( 11, oxx, ox(j1), ox(j2), ox(j3) )
                  is = 1
                  call qchksto( iw, oxx, ox(j2), ox(j3),
     $                          min(ox(j4),oxd(i)) )
               endif
            enddo
            if ( i4 .le. n3 ) then
               call qchksto( 9, cxx, cof(i1,1), cof(n2,1), cof(n3,1) )
            else
               call quadsto( 9, cxx, cof(i1,1), cof(i2,1), cof(i3,1) )
               call qchksto( 10, cxx, cof(i2,1), cof(i3,1), cof(i4,1) )
            endif
         endif
c
         do it = k1, k1 + ip
            do ir = l1, l1 + iq(it-k1+1)
               if ( icomax .ge. 0 ) then
                  if ( j4 .le. m3 ) then
                     cof(i4,2) = qchkget( 13,
     $                    co(m,n(m,j1,kz),j1,it,ir,kz),
     $                    co(m,n(m,m2,kz),m2,it,ir,kz),
     $                    co(m,j2m(i4),j4m(i4),it,ir,kz) )
                  else
                     cof(i4,2) = ( 1. - ofac ) * quadget( 13,
     $                    co(m,n(m,j1,kz),j1,it,ir,kz),
     $                    co(m,n(m,j2,kz),m2,it,ir,kz),
     $                    co(m,n(m,j3,kz),m3,it,ir,kz) )
     $                    + ofac * qchkget( 14,
     $                    co(m,n(m,j2,kz),j2,it,ir,kz),
     $                    co(m,n(m,j3,kz),j3,it,ir,kz),
     $                    co(m,j2m(i4),j4m(i4),it,ir,kz) )
                  endif
                  if ( j4n .gt. 0 ) then
                     if ( ib4 .le. nb3 ) then
                        cof(i4,2) = ( 1. - bfac ) * cof(i4,2)
     $                       + bfac * qchkget( 15,
     $                       co(m,ib1,mo,it,ir,kz),
     $                       co(m,nb2,mo,it,ir,kz),
     $                       co(m,j2n,j4n,it,ir,kz) )
                     else
                        cof(i4,2) = ( 1. - bfac ) * cof(i4,2) + bfac
     $                       * ( ( 1. - afac ) * quadget( 15,
     $                       co(m,ib1,mo,it,ir,kz),
     $                       co(m,ib2,mo,it,ir,kz),
     $                       co(m,ib3,mo,it,ir,kz) )
     $                       + afac * qchkget( 16,
     $                       co(m,ib2,mo,it,ir,kz),
     $                       co(m,ib3,mo,it,ir,kz),
     $                       co(m,j2n,j4n,it,ir,kz) ) )
                     endif
                  endif
               endif
               if ( icomax .gt. 0 ) then
                  opl(it,ir,kz) = cof(i4,2)
               else
                  iw = 0
                  do i = i1, ihi
                     iw = iw + 1
                     if ( j4m(i) .le. j3m(i) ) then
                        cof(i,2) = qchkget( iw, co(m,i,j1,it,ir,kz),
     $                       co(m,i,j2m(i),it,ir,kz),
     $                       co(m,i,j3m(i),it,ir,kz) )
                     else
                        cof(i,2) = (1.-ofac) * quadget( 11,
     $                       co(m,i,j1,it,ir,kz), co(m,i,j2,it,ir,kz),
     $                       co(m,i,j3,it,ir,kz) ) + ofac
     $                       * qchkget( iw, co(m,i,j2,it,ir,kz),
     $                       co(m,i,j3,it,ir,kz),
     $                       co(m,i,j4m(i),it,ir,kz) )
                     endif
                  enddo
                  if ( i4 .le. n3 ) then
                     opl(it,ir,kz) = qchkget( 9, cof(i1,2), cof(n2,2),
     $                                        cof(n3,2) )
                  else
                     opl(it,ir,kz) = ( 1. - cfac ) * quadget( 9,
     $                    cof(i1,2), cof(i2,2), cof(i3,2) )
     $                    + cfac * qchkget( 10, cof(i2,2), cof(i3,2),
     $                                      cof(i4,2) )
                  endif
               endif
c-debug[
c-debug;               if ( ioudeb .gt. 7 .or.
c-debug;     $              .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $              .not. abs(cof(i4,2)) .le. oudebl .or.
c-debug;     $              ( icomax .le. 0 .and.
c-debug;     $              ( .not. abs(cof(i1,2)) .le. oudebl .or.
c-debug;     $              .not. abs(cof(i2,2)) .le. oudebl .or.
c-debug;     $              .not. abs(cof(i3,2)) .le. oudebl ) ) ) then
c-debug;                  write(6,*) ' '
c-debug;                  if ( icomax .le. 0 ) then
c-debug;                     do i = i1,ihi
c-debug;                        if ( j4m(i) .le. j3m(i) ) then
c-debug;                           write(6,9414) m,it,ir,kz,'C>O','O',oxx,
c-debug;     $                          'K',cof(i,2),0.,i,j1,ox(j1),
c-debug;     $                          co(m,i,j1,it,ir,kz),
c-debug;     $                          i,j2m(i),min(ox(m2),oxd(i)),
c-debug;     $                          co(m,i,j2m(i),it,ir,kz),
c-debug;     $                          i,j3m(i),min(ox(m3),oxd(i)),
c-debug;     $                          co(m,i,j3m(i),it,ir,kz)
c-debug;                        else
c-debug;                           write(6,9414) m,it,ir,kz,'C>O','O',oxx,
c-debug;     $                          'K',cof(i,2),ofac,(i,j,ox(j),
c-debug;     $                          co(m,i,j,it,ir,kz),j=j1,j3),
c-debug;     $                          i,j4m(i),min(ox(j4),oxd(i)),
c-debug;     $                          co(m,i,j4m(i),it,ir,kz)
c-debug;                        endif
c-debug;                     enddo
c-debug;                  endif
c-debug;                  if ( j4 .le. m3 ) ofac = 0.
c-debug;                  if ( icomax .ge. 0 ) write(6,9414) m,it,ir,kz,'C>O',
c-debug;     $                 'o',oxx,'K',cof(i4,2),ofac,(n(m,j,kz),j,ox(j),
c-debug;     $                 co(m,n(m,j,kz),j,it,ir,kz),j=j1,j4-1),j2m(i4),
c-debug;     $                 j4m(i4),cof(4,4),co(m,j2m(i4),j4m(i4),it,ir,kz)
c-debug;                  if ( ib4 .le. nb3 ) afac = 0.
c-debug;                  if ( icomax .ge. 0 .and. j4n .gt. 0 ) write(6,9414)
c-debug;     $                 m,it,ir,kz,'C>O','c',cof(i4,1),'b',bfac,afac,
c-debug;     $                 (j,mo,cx(j),co(m,j,mo,it,ir,kz),j=ib1,ib4-1),
c-debug;     $                 j2n,j4n,cof(5,5),co(m,j2n,j4n,it,ir,kz)
c-debug;                  if ( i4 .le. n3 ) cfac = 0.
c-debug;                  if ( icomax .le. 0 ) write(6,9415) m,it,ir,kz,
c-debug;     $                 'C>O','C',cxx,opl(it,ir,kz),cfac,
c-debug;     $                 (' ',j,cof(j,1),cof(j,2),j=i1,i4)
c-debug; 9415             format(' COINTSMO(x',i1,',t',i2.2,',r',i2.2,
c-debug;     $                 ',z',i2.2,')',a3,' ',a1,f11.7,
c-debug;     $                 ' : K =',g15.7,' <--(f=',f10.7,
c-debug;     $                 ') kc,ko,CorO,K:',4(a1,' (',i1,')',2f11.7))
c-debug;               endif
c-debug]
            enddo
         enddo
c					! else if C < O: then i3 < nc
      else
c
         if ( j4 .gt. m3 ) ofac = (oxx-ox(j2))/(ox(j3)-ox(j2))
c							       ! if C = 0.0:
         if ( abs(xxc) .lt. small_1m6 ) then
c
            if ( j4 .le. m3 ) then
               j3m(1) = m3
               if ( m3 .ge. no ) j3m(1) = mo
               call qchksto( 1, oxx,
     $                       ox(j1), ox(m2), min(ox(m3),oxd(1)) )
               do it = k1, k1 + ip
                  do ir = l1, l1 + iq(it-k1+1)
                     opl(it,ir,kz) = qchkget( 1, co(m,1,j1,it,ir,kz),
     $                                        co(m,1,m2,it,ir,kz),
     $                                        co(m,1,j3m(1),it,ir,kz) )
c-debug[
c-debug;                     if ( ioudeb .gt. 7 .or. .not.
c-debug;     $                    abs(opl(it,ir,kz)) .le. oudebl ) then
c-debug;                        if ( ioudeb .le. 5 .or. ( it .eq. k1 .and.
c-debug;     $                       ir .eq. l1 ) ) write(6,*) ' '
c-debug;                        write(6,9414) m,it,ir,kz,'C=0','O',oxx,'K',
c-debug;     $                       opl(it,ir,kz),0.,(1,j,ox(j),
c-debug;     $                       co(m,1,j,it,ir,kz),j=j1,m2),1,j3m(1),
c-debug;     $                       co(m,1,j3m(1),it,ir,kz),min(ox(j3),oxd(1))
c-debug;                     endif
c-debug]
                  enddo
               enddo
            else
               j4m(1) = j4
               if ( j4 .ge. no ) j4m(1) = mo
               call quadsto( 1, oxx, ox(j1), ox(j2), ox(j3) )
               call qchksto( 2, oxx,
     $                       ox(j2), ox(j3), min(ox(j4),oxd(1)) )
               do it = k1,k1+ip
                  do ir = l1,l1+iq(it-k1+1)
                     opl(it,ir,kz) = (1.-ofac) * quadget( 1,
     $                    co(m,1,j1,it,ir,kz), co(m,1,j2,it,ir,kz),
     $                    co(m,1,j3,it,ir,kz) )
     $                    + ofac * qchkget( 2, co(m,1,j2,it,ir,kz),
     $                                      co(m,1,j3,it,ir,kz),
     $                                      co(m,1,j4m(1),it,ir,kz) )
c-debug[
c-debug;                     if ( ioudeb .gt. 7 .or. .not.
c-debug;     $                    abs(opl(it,ir,kz)) .le. oudebl ) then
c-debug;                        if ( ioudeb .le. 5 .or. ( it .eq. k1 .and.
c-debug;     $                       ir .eq. l1 ) ) write(6,*) ' '
c-debug;                        write(6,9414) m,it,ir,kz,'C=0','O',oxx,'K',
c-debug;     $                       opl(it,ir,kz),ofac,(1,j,ox(j),
c-debug;     $                       co(m,1,j,it,ir,kz),j=j1,j3),
c-debug;     $                       1,j4m(1),co(m,1,j4m(1),it,ir,kz),
c-debug;     $                       min(ox(j4),oxd(1))
c-debug;                     endif
c-debug]
                  enddo
               enddo
            endif
c			! we are done: return
            return
c
         endif
c						! else if O > C, and C not 0.0:
         icomax = -1
         if ( xxco .gt. xcd(1) - small_1m6 ) icomax = 1
         if ( i1 .lt. i2 ) cfac = (cxx-cx(i2))/(cx(i3)-cx(i2))
         if ( icomax .lt. 0 ) then
            j4 = min( j4 , n(m,i2,kz) )
            cof(j1,1) = ox(j1)
            cof(j2,1) = ox(j2)
            cof(j3,1) = ox(j3)
            cof(j4,1) = ox(j4)
            if ( j3 .ge. n(m,i3,kz) .and. xxc .ge. xcd(j3) ) then
               j4 = j3
               icomax = 0
               cof(j4,1) = log10(zzz(kz)+xodp)
            else if ( j4 .ge. n(m,i3,kz) ) then
               icomax = 0
               cof(j4,1) = log10(zzz(kz)+xodp)
            endif
         endif
         ihi = j4
         if ( icomax .ge. 0 ) then
            ihi = j4-1
            if ( i4 .lt. nc ) then
               j2m(4) = i4
               j4m(4) = mo
               cof(4,4) = cx(i4)
            else
               j4m(4) = max( n(m,i4-1,kz) - 2 , 1 )
               j2m(4) = n(m,j4m(4),kz)
               cof(4,4) = cxd(j4m(4))
            endif
            j4n = 0
            if ( xxc .gt. xcd(no-1) + small_1m6 ) then
               if ( icomax .gt. 0 ) cof(j4,1) = log10(zzz(kz)+xodp)
               bfac = min((xxc-xcd(no-1))/max(xcd(1)-2.*xcd(no-1),
     $              small_1m6),0.5)
               jb3 = min( indx(int(100.*max(xodp,0.))+1) + 1 , no )
               jb4 = min( jb3+1 , no )
               jb1 = max( jb3-2 , 1 )
               jb2 = jb3-1
               mb2 = jb1+1
               mb3 = jb1+2
               if ( jb4 .gt. mb3 )
     $              afac = (cof(j4,1)-ox(jb2))/(ox(jb3)-ox(jb2))
               if ( jb4 .lt. no ) then
                  j2n = n(m,jb4,kz)
                  j4n = jb4
                  cof(5,5) = ox(jb4)
               else
                  j2n = max( n(m,jb4-1,kz) - 2 , 1 )
                  j4n = mo
                  cof(5,5) = oxd(j2n)
               endif
            endif
         endif
c
         if ( icomax .ge. 0 ) then
            if ( i4 .le. n3 ) then
               call qchksto( 13, cxx, cx(i1), cx(n2), cof(4,4) )
            else
               call quadsto( 13, cxx, cx(i1), cx(i2), cx(i3) )
               call qchksto( 14, cxx, cx(i2), cx(i3), cof(4,4) )
            endif
            if ( j4n .gt. 0 ) then
               if ( jb4 .le. mb3 ) then
                  call qchksto( 15, cof(j4,1),
     $                          ox(jb1), ox(mb2), cof(5,5) )
               else
                  call quadsto( 15, cof(j4,1),
     $                          ox(jb1), ox(jb2), ox(jb3) )
                  call qchksto( 16, cof(j4,1),
     $                          ox(jb2), ox(jb3), cof(5,5) )
               endif
            endif
         endif
         if ( icomax .le. 0 ) then
            iw = 0
            is = 0
            do i = j1, ihi
               iw = iw + 1
               if ( i4 .le. n3 .or. i4 .gt. n(m,i,kz) ) then
                  call qchksto( iw, cxx, cx(i1), min(cx(n2),cxd(i)),
     $                          min(cx(n3),cxd(i)) )
               else
                  if ( is .eq. 0 )
     $                 call quadsto( 11, cxx, cx(i1), cx(i2), cx(i3) )
                  is = 1
                  call qchksto( iw, cxx,
     $                          cx(i2), cx(i3), min(cx(i4),cxd(i)) )
               endif
            enddo
            if ( j4 .le. m3 ) then
               call qchksto( 9, oxx, cof(j1,1), cof(m2,1), cof(m3,1) )
            else
               call quadsto( 9, oxx, cof(j1,1), cof(j2,1), cof(j3,1) )
               call qchksto( 10, oxx, cof(j2,1), cof(j3,1), cof(j4,1) )
            endif
         endif
c
         do it = k1, k1 + ip
            do ir = l1, l1 + iq(it-k1+1)
               if ( icomax .ge. 0 ) then
                  if ( i4 .le. n3 ) then
                     cof(j4,2) = qchkget( 13, co(m,i1,mo,it,ir,kz),
     $                                   co(m,n2,mo,it,ir,kz),
     $                                   co(m,j2m(4),j4m(4),it,ir,kz) )
                  else
                     cof(j4,2) = ( 1. - cfac ) * quadget( 13,
     $                    co(m,i1,mo,it,ir,kz), co(m,i2,mo,it,ir,kz),
     $                    co(m,i3,mo,it,ir,kz) )
     $                    + cfac * qchkget( 14, co(m,i2,mo,it,ir,kz),
     $                                   co(m,i3,mo,it,ir,kz),
     $                                   co(m,j2m(4),j4m(4),it,ir,kz) )
                  endif
                  if ( j4n .gt. 0 ) then
                     if ( jb4 .le. mb3 ) then
                        cof(j4,2) = ( 1. - bfac ) * cof(j4,2)
     $                       + bfac * qchkget( 15,
     $                                  co(m,n(m,jb1,kz),jb1,it,ir,kz),
     $                                  co(m,n(m,mb2,kz),mb2,it,ir,kz),
     $                                  co(m,j2n,j4n,it,ir,kz) )
                     else
                        cof(j4,2) = ( 1. - bfac ) * cof(j4,2) + bfac
     $                       * ( ( 1. - afac ) * quadget( 15,
     $                                 co(m,n(m,jb1,kz),jb1,it,ir,kz),
     $                                 co(m,n(m,jb2,kz),mb2,it,ir,kz),
     $                                 co(m,n(m,jb3,kz),mb3,it,ir,kz) )
     $                       + afac * qchkget( 16,
     $                                  co(m,n(m,jb2,kz),jb2,it,ir,kz),
     $                                  co(m,n(m,jb3,kz),jb3,it,ir,kz),
     $                                  co(m,j2n,j4n,it,ir,kz) ) )
                     endif
                  endif
               endif
               if ( icomax .gt. 0 ) then
                  opl(it,ir,kz) = cof(j4,2)
               else
                  iw = 0
                  do i = j1, ihi
                     iw = iw + 1
                     if ( i4 .le. n3 .or. i4 .gt. n(m,i,kz) ) then
                        cof(i,2) = qchkget( iw, co(m,i1,i,it,ir,kz),
     $                             co(m,n2,i,it,ir,kz),
     $                             co(m,min(n3,n(m,i,kz)),i,it,ir,kz) )
                     else
                        cof(i,2) = ( 1. - cfac ) * quadget( 11,
     $                       co(m,i1,i,it,ir,kz), co(m,i2,i,it,ir,kz),
     $                       co(m,i3,i,it,ir,kz) )
     $                       + cfac * qchkget( iw, co(m,i2,i,it,ir,kz),
     $                       co(m,i3,i,it,ir,kz), co(m,i4,i,it,ir,kz) )
                     endif
                  enddo
                  if ( j4 .le. m3 ) then
                     opl(it,ir,kz) = qchkget( 9, cof(j1,2), cof(m2,2),
     $                                        cof(m3,2) )
                  else
                     opl(it,ir,kz) = ( 1. - ofac ) * quadget( 9,
     $                    cof(j1,2), cof(j2,2), cof(j3,2) )
     $                    + ofac * qchkget( 10, cof(j2,2), cof(j3,2),
     $                                      cof(j4,2) )
                  endif
               endif
c-debug[
c-debug;               if ( ioudeb .gt. 7 .or.
c-debug;     $              .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $              .not. abs(cof(j4,2)) .le. oudebl .or.
c-debug;     $              ( icomax .le. 0 .and.
c-debug;     $              ( .not. abs(cof(j1,2)) .le. oudebl .or.
c-debug;     $              .not. abs(cof(j2,2)) .le. oudebl .or.
c-debug;     $              .not. abs(cof(j3,2)) .le. oudebl ) ) ) then
c-debug;                  write(6,*) ' '
c-debug;                  if ( icomax .le. 0 ) then
c-debug;                     do i = j1,ihi
c-debug;                        if ( i4 .le. n3 .or. i4 .gt. n(m,i,kz) ) then
c-debug;                           write(6,9414) m,it,ir,kz,'C<O','C',cxx,'K',
c-debug;     $                          cof(i,2),0.,i1,i,cx(i1),
c-debug;     $                          co(m,i1,i,it,ir,kz),n2,i,
c-debug;     $                          min(cx(n2),cxd(i)),co(m,n2,i,it,ir,kz),
c-debug;     $                          min(n3,n(m,i,kz)),i,min(cx(n3),cxd(i)),
c-debug;     $                          co(m,min(n3,n(m,i,kz)),i,it,ir,kz)
c-debug;                        else
c-debug;                           write(6,9414) m,it,ir,kz,'C<O','C',cxx,'K',
c-debug;     $                          cof(i,2),cfac,(j,i,min(cx(j),cxd(i)),
c-debug;     $                          co(m,j,i,it,ir,kz),j=i1,i4)
c-debug;                        endif
c-debug;                     enddo
c-debug;                  endif
c-debug;                  if ( i4 .le. n3 ) cfac = 0.
c-debug;                  if ( icomax .ge. 0 ) write(6,9414) m,it,ir,kz,
c-debug;     $                 'C<O','c',cxx,'K',cof(j4,2),cfac,(j,mo,cx(j),
c-debug;     $                 co(m,j,mo,it,ir,kz),j=i1,i4-1),j2m(4),
c-debug;     $                 j4m(4),cof(4,4),co(m,j2m(4),j4m(4),it,ir,kz)
c-debug;                  if ( jb4 .le. mb3 ) afac = 0.
c-debug;                  if ( icomax .ge. 0 .and. j4n .gt. 0 ) write(6,9414)
c-debug;     $                 m,it,ir,kz,'C<O','o',cof(j4,1),'b',bfac,afac,
c-debug;     $                 (n(m,j,kz),j,ox(j),co(m,n(m,j,kz),j,it,ir,kz),
c-debug;     $                 j=jb1,jb4-1),j2n,j4n,cof(5,5),
c-debug;     $                 co(m,j2n,j4n,it,ir,kz)
c-debug;                  if ( j4 .le. m3 ) ofac = 0.
c-debug;                  if ( icomax .le. 0 ) write(6,9415) m,it,ir,kz,
c-debug;     $                 'C<O','O',oxx,opl(it,ir,kz),ofac,
c-debug;     $                 (' ',j,cof(j,1),cof(j,2),j=j1,j4)
c-debug;               endif
c-debug]
            enddo
         enddo
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine cointerp(xxc,xxo,kz)
c     ===============================
c
c     Interpolate in C and O abundances.
c
c  This subroutine yields less-smooth opacities than alternate
c  subroutine COINTSMO above.
c
c  Note that the quadratic-interpolation function quad has been
c  replaced with the function qchk here; the latter function checks
c  whether two of the interpolation points are nearly coincident
c  (which would magnify the effect of any uncertainties in the
c  tabulated opacities), and uses something more nearly linear
c  if so.  This is sometimes necessary to prevent wildly wrong
c  opacity values for certain Z-values above Z=0.03.
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      common/bb_opal_z/ xodp,xcdp,xxco,cxx,oxx,
     $     l1,l2,l3,l4,k1,k2,k3,k4,ip,iq(4),kzf,kzg,kzh,kzf2
      save /bb_opal_z/
c-debug[
c-debug;      common/outdeb/ ioudeb,oudebl,koudeb
c-debug]
c
c===
c
c-debug[
c-debug; 9413 format(' '/' COINTERP: m=',i2,' kz=',i3,' xxc',f10.7,
c-debug;     $     ' xxo',f10.7,' xxc+xxo',f10.7,' xxco',f10.7,
c-debug;     $     ' COmax',f10.7,' nc',i2,' n(m,1:nc)',8i2)
c-debug]
c
      is = 0
c							! if C+O = 0:
      if ( max( abs(xxc) , abs(xxo) ) .lt. small_1m6 ) then
         do it = k1,k1+ip
            do ir = l1,l1+iq(it-k1+1)
               opl(it,ir,kz) = co(m,1,1,it,ir,kz)
            enddo
         enddo
c
         return
c         ! include boundaries (later, fix any possible division by 0)
c
      else if ( xxc .gt. xcd(3)-small_1m6 ) then
c__________
         oxdp = log10(zzz(kz)+xodp)
c					  ! interpolation in region c1:
c
c     ! include boundaries (qchk & fac fix any possible division by 0)
c
         if ( xxc .gt. xcd(2)-small_1m6 ) then
c				     ! handle possibility that xodp = 0
            fac = max(min((oxx-ox(1))/max(oxdp-ox(1),small_1m6),1.),0.)
c
            do it = k1,k1+ip
               do ir = l1,l1+iq(it-k1+1)
                  b(1) = qchk(is,1,cxx,co(m,nc-2,1,it,ir,kz),
     $                 co(m,nc-1,1,it,ir,kz),co(m,nc,1,it,ir,kz),
     $                 cx(nc-2),cx(nc-1),cx(nc))
                  b(2) = qchk(is,2,cxx,co(m,nc,1,it,ir,kz),
     $                 co(m,n(m,2,kz),2,it,ir,kz),
     $                 co(m,n(m,3,kz),3,it,ir,kz),
     $                 cxd(1),cxd(2),cxd(3))
c				     ! handle possibility that xodp = 0
                  opl(it,ir,kz) = b(1)+(b(2)-b(1))*fac
                  is = 1
c-debug[
c-debug;                  if ( .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(1)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(2)) .le. oudebl .or.
c-debug;     $                 ioudeb .gt. 5 ) then
c-debug;                     write(6,9413) m,kz,xxc,xxo,xxc+xxo,xxco,
c-debug;     $                    xc(nc),nc,(n(m,j,kz),j=1,nc)
c-debug;                     koudeb = koudeb+1
c-debug;                     write(6,9414) 1,'co(m,',nc-2,1,it,ir,
c-debug;     $                    co(m,nc-2,1,it,ir,kz),'co(m,',nc-1,
c-debug;     $                    1,it,ir,co(m,nc-1,1,it,ir,kz),
c-debug;     $                    'diag(',m,1,it,ir,
c-debug;     $                    co(m,nc,1,it,ir,kz),'cxx',cxx,
c-debug;     $                    ' cx(',nc-2,cx(nc-2),' cx(',nc-1,
c-debug;     $                    cx(nc-1),' cx(',nc,cx(nc)
c-debug; 9414                format(' b',i1,3(' ',a5,i1,',',i1,',',
c-debug;     $                    i2,',',i2,')',f12.7),' ',a3,f12.7,
c-debug;     $                    3(' ',a4,i1,')',f12.7))
c-debug;                     write(6,9414) 2,'diag(',m,1,it,ir,
c-debug;     $                    co(m,nc,1,it,ir,kz),'diag(',m,2,it,
c-debug;     $                    ir,co(m,n(m,2,kz),2,it,ir,kz),
c-debug;     $                    'diag(',m,3,it,ir,
c-debug;     $                    co(m,n(m,3,kz),3,it,ir,kz),'cxx',
c-debug;     $                    cxx,'cxd(',1,cxd(1),'cxd(',2,
c-debug;     $                    cxd(2),'cxd(',3,cxd(3)
c-debug;                     write(6,9415) b(1),b(2),0.,'oxx',oxx,
c-debug;     $                    ' ox(',1,ox(1),'oxdp',0,oxdp,'----',
c-debug;     $                    0,0.,it,ir,opl(it,ir,kz),'c1  '
c-debug; 9415                format(' --> b:',3f12.7,' ',a3,f12.7,
c-debug;     $                    3(' ',a4,i1,')',f12.7),' --> opl(',
c-debug;     $                    i2,',',i2,') =',f12.7,'  region ',
c-debug;     $                    a4)
c-debug;                  endif
c-debug]
               enddo
            enddo
c					  ! interpolation in region c2:
         else
            do it = k1,k1+ip
               do ir = l1,l1+iq(it-k1+1)
                  b(1) = qchk(is,1,cxx,co(m,nc-2,1,it,ir,kz),
     $                 co(m,nc-1,1,it,ir,kz),co(m,nc,1,it,ir,kz),
     $                 cx(nc-2),cx(nc-1),cx(nc))
                  b(2) = qchk(is,2,cxx,co(m,n(m,2,kz)-2,2,it,ir,kz),
     $                 co(m,n(m,2,kz)-1,2,it,ir,kz),
     $                 co(m,n(m,2,kz),2,it,ir,kz),
     $                 cx(n(m,2,kz)-2),cx(n(m,2,kz)-1),cxd(2))
                  b(3) = qchk(is,3,cxx,co(m,nc,1,it,ir,kz),
     $                 co(m,n(m,2,kz),2,it,ir,kz),
     $                 co(m,n(m,3,kz),3,it,ir,kz),
     $                 cxd(1),cxd(2),cxd(3))
                  opl(it,ir,kz) = qchk(is,4,oxx,b(1),b(2),b(3),
     $                 ox(1),ox(2),oxdp)
                  is = 1
c-debug[
c-debug;                  if ( .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(1)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(2)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(3)) .le. oudebl .or.
c-debug;     $                 ioudeb .gt. 5 ) then
c-debug;                     write(6,9413) m,kz,xxc,xxo,xxc+xxo,xxco,
c-debug;     $                    xc(nc),nc,(n(m,j,kz),j=1,nc)
c-debug;                     koudeb = koudeb+1
c-debug;                     write(6,9414) 1,'co(m,',nc-2,1,it,ir,
c-debug;     $                    co(m,nc-2,1,it,ir,kz),'co(m,',nc-1,
c-debug;     $                    1,it,ir,co(m,nc-1,1,it,ir,kz),
c-debug;     $                    'diag(',m,1,it,ir,
c-debug;     $                    co(m,nc,1,it,ir,kz),'cxx',cxx,
c-debug;     $                    ' cx(',nc-2,cx(nc-2),' cx(',nc-1,
c-debug;     $                    cx(nc-1),' cx(',nc,cx(nc)
c-debug;                     write(6,9414) 2,'co(m,',n(m,2,kz)-2,2,it,
c-debug;     $                    ir,co(m,n(m,2,kz)-2,2,it,ir,kz),
c-debug;     $                    'co(m,',n(m,2,kz)-1,2,it,ir,
c-debug;     $                    co(m,n(m,2,kz)-1,2,it,ir,kz),
c-debug;     $                    'diag(',m,2,it,ir,
c-debug;     $                    co(m,n(m,2,kz),2,it,ir,kz),
c-debug;     $                    'cxx',cxx,
c-debug;     $                    ' cx(',n(m,2,kz)-2,cx(n(m,2,kz)-2),
c-debug;     $                    ' cx(',n(m,2,kz)-1,cx(n(m,2,kz)-1),
c-debug;     $                    'cxd(',2,cxd(2)
c-debug;                     write(6,9414) 3,'diag(',m,1,it,ir,
c-debug;     $                    co(m,nc,1,it,ir,kz),'diag(',m,2,it,
c-debug;     $                    ir,co(m,n(m,2,kz),2,it,ir,kz),
c-debug;     $                    'diag(',m,3,it,ir,
c-debug;     $                    co(m,n(m,3,kz),3,it,ir,kz),'cxx',
c-debug;     $                    cxx,'cxd(',1,cxd(1),'cxd(',2,
c-debug;     $                    cxd(2),'cxd(',3,cxd(3)
c-debug;                     write(6,9415) b(1),b(2),b(3),'oxx',oxx,
c-debug;     $                    ' ox(',1,ox(1),' ox(',2,ox(2),
c-debug;     $                    'oxdp',0,oxdp,it,ir,opl(it,ir,kz),
c-debug;     $                    'c2  '
c-debug;                  endif
c-debug]
               enddo
            enddo
         endif
c
         return
c
      else if ( nc .ge. 5 ) then
c__________			   ! interpolation in regions c3 to c6:
         do i = 4,nc-1
c
c	   ! do not go beyond middle (where c3-c6 overlaps o3-o6), and
c	   ! include boundaries (qchk fixes any possible division by 0)
c
            if ( xxc .gt. xcd(i)-small_1m6 .and.
     $           xxo .gt. xo(i-1)-small_1m6 .and.
     $           xcd(i-1) .gt. xc(i-1) ) then
c
               oxdp = log10(zzz(kz)+xodp)
               m1 = i-1
               m2 = i-2
c
               do it = k1,k1+ip
                  do ir = l1,l1+iq(it-k1+1)
                     b(1) = qchk(is,1,cxx,
     $                    co(m,n(m,m2,kz)-2,m2,it,ir,kz),
     $                    co(m,n(m,m2,kz)-1,m2,it,ir,kz),
     $                    co(m,n(m,m2,kz),m2,it,ir,kz),
     $                    cx(n(m,m2,kz)-2),cx(n(m,m2,kz)-1),cxd(m2))
                     b(2) = qchk(is,2,cxx,
     $                    co(m,n(m,m1,kz)-2,m1,it,ir,kz),
     $                    co(m,n(m,m1,kz)-1,m1,it,ir,kz),
     $                    co(m,n(m,m1,kz),m1,it,ir,kz),
     $                    cx(n(m,m1,kz)-2),cx(n(m,m1,kz)-1),cxd(m1))
                     b(3) = qchk(is,3,cxx,
     $                    co(m,n(m,m2,kz),m2,it,ir,kz),
     $                    co(m,n(m,m1,kz),m1,it,ir,kz),
     $                    co(m,n(m,i,kz),i,it,ir,kz),
     $                    cxd(m2),cxd(m1),cxd(i))
                     opl(it,ir,kz) = qchk(is,4,oxx,b(1),b(2),b(3),
     $                    ox(m2),ox(m1),oxdp)
                     is = 1
c-debug[
c-debug;                     if ( .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $                    .not. abs(b(1)) .le. oudebl .or.
c-debug;     $                    .not. abs(b(2)) .le. oudebl .or.
c-debug;     $                    .not. abs(b(3)) .le. oudebl .or.
c-debug;     $                    ioudeb .gt. 5 ) then
c-debug;                        write(6,9413) m,kz,xxc,xxo,xxc+xxo,xxco,
c-debug;     $                       xc(nc),nc,(n(m,j,kz),j=1,nc)
c-debug;                        koudeb = koudeb+1
c-debug;                        write(6,9414) 1,'co(m,',n(m,m2,kz)-2,
c-debug;     $                       m2,it,ir,
c-debug;     $                       co(m,n(m,m2,kz)-2,m2,it,ir,kz),
c-debug;     $                       'co(m,',n(m,m2,kz)-1,m2,it,ir,
c-debug;     $                       co(m,n(m,m2,kz)-1,m2,it,ir,kz),
c-debug;     $                       'diag(',m,m2,it,ir,
c-debug;     $                       co(m,n(m,m2,kz),m2,it,ir,kz),
c-debug;     $                       'cxx',cxx,' cx(',n(m,m2,kz)-2,
c-debug;     $                       cx(n(m,m2,kz)-2),' cx(',
c-debug;     $                       n(m,m2,kz)-1,cx(n(m,m2,kz)-1),
c-debug;     $                       'cxd(',m2,cxd(m2)
c-debug;                        write(6,9414) 2,'co(m,',n(m,m1,kz)-2,
c-debug;     $                       m1,it,ir,
c-debug;     $                       co(m,n(m,m1,kz)-2,m1,it,ir,kz),
c-debug;     $                       'co(m,',n(m,m1,kz)-1,m1,it,ir,
c-debug;     $                       co(m,n(m,m1,kz)-1,m1,it,ir,kz),
c-debug;     $                       'diag(',m,m1,it,ir,
c-debug;     $                       co(m,n(m,m1,kz),m1,it,ir,kz),
c-debug;     $                       'cxx',cxx,' cx(',n(m,m1,kz)-2,
c-debug;     $                       cx(n(m,m1,kz)-2),' cx(',
c-debug;     $                       n(m,m1,kz)-1,cx(n(m,m1,kz)-1),
c-debug;     $                       'cxd(',m1,cxd(m1)
c-debug;                        write(6,9414) 3,'diag(',m,m2,it,ir,
c-debug;     $                       co(m,n(m,m2,kz),m2,it,ir,kz),
c-debug;     $                       'diag(',m,m1,it,ir,
c-debug;     $                       co(m,n(m,m1,kz),m1,it,ir,kz),
c-debug;     $                       'diag(',m,i,it,ir,
c-debug;     $                       co(m,n(m,i,kz),i,it,ir,kz),
c-debug;     $                       'cxx',cxx,'cxd(',m2,cxd(m2),
c-debug;     $                       'cxd(',m1,cxd(m1),'cxd(',i,cxd(i)
c-debug;                        write(6,9415) b(1),b(2),b(3),'oxx',
c-debug;     $                       oxx,' ox(',i-2,ox(i-2),' ox(',
c-debug;     $                       i-1,ox(i-1),'oxdp',0,oxdp,it,ir,
c-debug;     $                       opl(it,ir,kz),'c3-6'
c-debug;                     endif
c-debug]
                  enddo
               enddo
c
               return
c
            endif
c
         enddo
      endif
c
c	   ! include boundaries (later, fix any possible division by 0)
c
      if ( xxo .gt. xod(3)-small_1m6 ) then
c__________
         cxdp = log10(zzz(kz)+xcdp)
c					  ! interpolation in region o1:
c
c     ! include boundaries (qchk & fac fix any possible division by 0)
c
         if ( xxo .gt. xod(2)-small_1m6 ) then
c				     ! handle possibility that xcdp = 0
            fac = max(min((cxx-cx(1))/max(cxdp-cx(1),small_1m6),1.),0.)
c
            do it = k1,k1+ip
               do ir = l1,l1+iq(it-k1+1)
                  b(1) = qchk(is,1,oxx,co(m,1,no-2,it,ir,kz),
     $                 co(m,1,no-1,it,ir,kz),co(m,1,mo,it,ir,kz),
     $                 ox(no-2),ox(no-1),ox(no))
                  b(2) = qchk(is,2,oxx,co(m,1,mo,it,ir,kz),
     $                 co(m,2,mo,it,ir,kz),co(m,3,mo,it,ir,kz),
     $                 oxd(1),oxd(2),oxd(3))
c				     ! handle possibility that xcdp = 0
                  opl(it,ir,kz) = b(1)+(b(2)-b(1))*fac
                  is = 1
c-debug[
c-debug;                  if ( .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(1)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(2)) .le. oudebl .or.
c-debug;     $                 ioudeb .gt. 5 ) then
c-debug;                     write(6,9413) m,kz,xxc,xxo,xxc+xxo,xxco,
c-debug;     $                    xc(nc),nc,(n(m,j,kz),j=1,nc)
c-debug;                     koudeb = koudeb+1
c-debug;                     write(6,9414) 1,'co(m,',1,no-2,it,ir,
c-debug;     $                    co(m,1,no-2,it,ir,kz),'co(m,',1,
c-debug;     $                    no-1,it,ir,co(m,1,no-1,it,ir,kz),
c-debug;     $                    'digo(',m,no-1,it,ir,
c-debug;     $                    co(m,1,mo,it,ir,kz),'oxx',
c-debug;     $                    oxx,' ox(',no-2,ox(no-2),' ox(',
c-debug;     $                    no-1,ox(no-1),' ox(',no,ox(no)
c-debug;                     write(6,9414) 2,'digo(',m,no-1,it,ir,
c-debug;     $                    co(m,1,mo,it,ir,kz),'digo(',m,no-2,
c-debug;     $                    it,ir,co(m,2,mo,it,ir,kz),'digo(',m,
c-debug;     $                    no-3,it,ir,co(m,3,mo,it,ir,kz),
c-debug;     $                    'oxx',oxx,'oxd(',1,oxd(1),'oxd(',2,
c-debug;     $                    oxd(2),'oxd(',3,oxd(3)
c-debug;                     write(6,9415) b(1),b(2),0.,'cxx',cxx,
c-debug;     $                    ' cx(',1,cx(1),'cxdp',0,cxdp,'----',
c-debug;     $                    0,0.,it,ir,opl(it,ir,kz),'o1  '
c-debug;                  endif
c-debug]
               enddo
            enddo
c					  ! interpolation in region o2:
         else
            do it = k1,k1+ip
               do ir = l1,l1+iq(it-k1+1)
                  b(1) = qchk(is,1,oxx,co(m,1,no-2,it,ir,kz),
     $                 co(m,1,no-1,it,ir,kz),co(m,1,mo,it,ir,kz),
     $                 ox(no-2),ox(no-1),ox(no))
                  b(2) = qchk(is,2,oxx,co(m,2,n(m,2,kz)-2,it,ir,kz),
     $                 co(m,2,n(m,2,kz)-1,it,ir,kz),
     $                 co(m,2,mo,it,ir,kz),
     $                 ox(n(m,2,kz)-2),ox(n(m,2,kz)-1),oxd(2))
                  b(3) = qchk(is,3,oxx,co(m,1,mo,it,ir,kz),
     $                 co(m,2,mo,it,ir,kz),co(m,3,mo,it,ir,kz),
     $                 oxd(1),oxd(2),oxd(3))
                  opl(it,ir,kz) = qchk(is,4,cxx,b(1),b(2),b(3),
     $                 cx(1),cx(2),cxdp)
                  is = 1
c-debug[
c-debug;                  if ( .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(1)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(2)) .le. oudebl .or.
c-debug;     $                 .not. abs(b(3)) .le. oudebl .or.
c-debug;     $                 ioudeb .gt. 5 ) then
c-debug;                     write(6,9413) m,kz,xxc,xxo,xxc+xxo,xxco,
c-debug;     $                    xc(nc),nc,(n(m,j,kz),j=1,nc)
c-debug;                     koudeb = koudeb+1
c-debug;                     write(6,9414) 1,'co(m,',1,no-2,it,ir,
c-debug;     $                    co(m,1,no-2,it,ir,kz),'co(m,',1,
c-debug;     $                    no-1,it,ir,co(m,1,no-1,it,ir,kz),
c-debug;     $                    'digo(',m,no-1,it,ir,
c-debug;     $                    co(m,1,mo,it,ir,kz),'oxx',
c-debug;     $                    oxx,' ox(',no-2,ox(no-2),' ox(',
c-debug;     $                    no-1,ox(no-1),' ox(',no,ox(no)
c-debug;                     write(6,9414) 2,'co(m,',2,n(m,2,kz)-2,it,
c-debug;     $                    ir,co(m,2,n(m,2,kz)-2,it,ir,kz),
c-debug;     $                    'co(m,',2,n(m,2,kz)-1,it,ir,
c-debug;     $                    co(m,2,n(m,2,kz)-1,it,ir,kz),
c-debug;     $                    'digo(',m,no-2,it,ir,
c-debug;     $                    co(m,2,mo,it,ir,kz),'oxx',oxx,
c-debug;     $                    ' ox(',n(m,2,kz)-2,ox(n(m,2,kz)-2),
c-debug;     $                    ' ox(',n(m,2,kz)-1,ox(n(m,2,kz)-1),
c-debug;     $                    'oxd(',2,oxd(2)
c-debug;                     write(6,9414) 3,'digo(',m,no-1,it,ir,
c-debug;     $                    co(m,1,mo,it,ir,kz),'digo(',m,no-2,
c-debug;     $                    it,ir,co(m,2,mo,it,ir,kz),'digo(',m,
c-debug;     $                    nc-3,it,ir,co(m,3,mo,it,ir,kz),
c-debug;     $                    'oxx',oxx,'oxd(',1,oxd(1),'oxd(',2,
c-debug;     $                    oxd(2),'oxd(',3,oxd(3)
c-debug;                     write(6,9415) b(1),b(2),b(3),'cxx',cxx,
c-debug;     $                    ' cx(',1,cx(1),' cx(',2,cx(2),
c-debug;     $                    'cxdp',0,cxdp,it,ir,opl(it,ir,kz),
c-debug;     $                    'o2  '
c-debug;                  endif
c-debug]
               enddo
            enddo
         endif
c
         return
c
      else if ( no .ge. 5 ) then
c__________			   ! interpolation in regions o3 to o6:
         do i = 4,no-1
c
c	   ! do not go beyond middle (where o3-o6 overlaps c3-c6), and
c	   ! include boundaries (qchk fixes any possible division by 0)
c
            if ( xxo .gt. xod(i)-small_1m6 .and.
     $           xxc .ge. xc(i-1)-small_1m6 .and.
     $           xod(i-1) .gt. xo(i-1)-small_1m6 ) then
c
               cxdp = log10(zzz(kz)+xcdp)
               m2 = i-2
               m1 = i-1
c
               do it = k1,k1+ip
                  do ir = l1,l1+iq(it-k1+1)
                     b(1) = qchk(is,1,oxx,
     $                    co(m,m2,n(m,m2,kz)-2,it,ir,kz),
     $                    co(m,m2,n(m,m2,kz)-1,it,ir,kz),
     $                    co(m,m2,mo,it,ir,kz),
     $                    ox(n(m,m2,kz)-2),ox(n(m,m2,kz)-1),oxd(m2))
                     b(2) = qchk(is,2,oxx,
     $                    co(m,m1,n(m,m1,kz)-2,it,ir,kz),
     $                    co(m,m1,n(m,m1,kz)-1,it,ir,kz),
     $                    co(m,m1,mo,it,ir,kz),
     $                    ox(n(m,m1,kz)-2),ox(n(m,m1,kz)-1),oxd(m1))
                     b(3) = qchk(is,3,oxx,co(m,m2,mo,it,ir,kz),
     $                    co(m,m1,mo,it,ir,kz),co(m,i,mo,it,ir,kz),
     $                    oxd(m2),oxd(m1),oxd(i))
                     opl(it,ir,kz) = qchk(is,4,cxx,b(1),b(2),b(3),
     $                    cx(m2),cx(m1),cxdp)
                     is = 1
c-debug[
c-debug;                     if ( .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $                    .not. abs(b(1)) .le. oudebl .or.
c-debug;     $                    .not. abs(b(2)) .le. oudebl .or.
c-debug;     $                    .not. abs(b(3)) .le. oudebl .or.
c-debug;     $                    ioudeb .gt. 5 ) then
c-debug;                        write(6,9413) m,kz,xxc,xxo,xxc+xxo,xxco,
c-debug;     $                       xc(nc),nc,(n(m,j,kz),j=1,nc)
c-debug;                        koudeb = koudeb+1
c-debug;                        write(6,9414) 1,'co(m,',m2,
c-debug;     $                       n(m,m2,kz)-2,it,ir,
c-debug;     $                       co(m,m2,n(m,m2,kz)-2,it,ir,kz),
c-debug;     $                       'co(m,',m2,n(m,m2,kz)-1,it,ir,
c-debug;     $                       co(m,m2,n(m,m2,kz)-1,it,ir,kz),
c-debug;     $                       'digo(',m,no-m2,it,ir,
c-debug;     $                       co(m,m2,mo,it,ir,kz),'oxx',oxx,
c-debug;     $                       ' ox(',n(m,m2,kz)-2,
c-debug;     $                       ox(n(m,m2,kz)-2),' ox(',
c-debug;     $                       n(m,m2,kz)-1,ox(n(m,m2,kz)-1),
c-debug;     $                       'oxd(',m2,oxd(m2)
c-debug;                        write(6,9414) 2,'co(m,',m1,
c-debug;     $                       n(m,m1,kz)-2,it,ir,
c-debug;     $                       co(m,m1,n(m,m1,kz)-2,it,ir,kz),
c-debug;     $                       'co(m,',m1,n(m,m1,kz)-1,it,ir,
c-debug;     $                       co(m,m1,n(m,m1,kz)-1,it,ir,kz),
c-debug;     $                       'digo(',m,no-m1,it,ir,
c-debug;     $                       co(m,m1,mo,it,ir,kz),'oxx',oxx,
c-debug;     $                       ' ox(',n(m,m1,kz)-2,
c-debug;     $                       ox(n(m,m1,kz)-2),' ox(',
c-debug;     $                       n(m,m1,kz)-1,ox(n(m,m1,kz)-1),
c-debug;     $                       'oxd(',m1,oxd(m1)
c-debug;                        write(6,9414) 3,'digo(',m,no-m2,it,ir,
c-debug;     $                       co(m,m2,mo,it,ir,kz),'digo(',
c-debug;     $                       m,no-m1,it,ir,
c-debug;     $                       co(m,m1,mo,it,ir,kz),
c-debug;     $                       'digo(',m,no-i,it,ir,
c-debug;     $                       co(m,i,mo,it,ir,kz),'oxx',oxx,
c-debug;     $                       'oxd(',m2,oxd(m2),'oxd(',m1,
c-debug;     $                       oxd(m1),'oxd(',i,oxd(i)
c-debug;                        write(6,9415) b(1),b(2),b(3),'cxx',
c-debug;     $                       cxx,' cx(',m2,cx(m2),' cx(',m1,
c-debug;     $                       cx(m1),'cxdp',0,cxdp,it,ir,
c-debug;     $                       opl(it,ir,kz),'o3-6'
c-debug;                     endif
c-debug]
                  enddo
               enddo
c
               return
c
            endif
c
         enddo
c
      endif
c__________		! else, interpolation in lower left of C-O grid
c
c.....find index of C grid
c                 (must also allow index = nc, to avoid extrapolation)
c
      ie = 100 * max( xxc , 0. ) + 1
      i3 = max( min( indx(ie) + 1 , nc ) , 3 )
      i1 = i3-2
      i2 = i3-1
c
c.....find index of O grid:
c                   must also allow index = no, to avoid extrapolation
c
      ie = 100 * max( xxo , 0. ) + 1
      j3 = max( min( indx(ie) + 1 , no ) , 3 )
      j1 = j3-2
      j2 = j3-1
c			! lower-O part of grid: interpolate C before O:
c
      if ( j3 .lt. no .and. i3 .le. n(m,j3,kz) .and. 
     $     ( xxc .lt. xcd(j3)+small_1m6 .or. xxc .ge. xxo ) ) then
c
         do it = k1,k1+ip
            do ir = l1,l1+iq(it-k1+1)
               iw = 0
               do jx = j1,j1+2
                  iw = iw+1
c		 ! if i3 = n(m,jx,kz), must replace cx(i3) with cxd(jx)
                  b(iw) = qchk(is,iw,cxx,co(m,i1,jx,it,ir,kz),
     $                 co(m,i2,jx,it,ir,kz),co(m,i3,jx,it,ir,kz),
     $                 cx(i1),cx(i2),min(cx(i3),cxd(jx)))
               enddo
               iw = iw+1
               opl(it,ir,kz) = qchk(is,iw,oxx,b(1),b(2),b(3),
     $              ox(j1),ox(j2),ox(j3))
               is = 1
c-debug[
c-debug;               if ( .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $              .not. abs(b(1)) .le. oudebl .or.
c-debug;     $              .not. abs(b(2)) .le. oudebl .or.
c-debug;     $              .not. abs(b(3)) .le. oudebl .or.
c-debug;     $              ioudeb .gt. 5 ) then
c-debug;                  write(6,9413) m,kz,xxc,xxo,xxc+xxo,xxco,
c-debug;     $                 xc(nc),nc,(n(m,j,kz),j=1,nc)
c-debug;                  koudeb = koudeb+1
c-debug;                  iw = 0
c-debug;                  do jx = j1,j1+2
c-debug;                     iw = iw+1
c-debug;                     if ( cx(i3) .le. cxd(jx) ) then
c-debug;                        write(6,9414) iw,'co(m,',i1,jx,it,ir,
c-debug;     $                       co(m,i1,jx,it,ir,kz),'co(m,',i2,
c-debug;     $                       jx,it,ir,co(m,i2,jx,it,ir,kz),
c-debug;     $                       'co(m,',i3,jx,it,ir,
c-debug;     $                       co(m,i3,jx,it,ir,kz),
c-debug;     $                       'cxx',cxx,' cx(',i1,cx(i1),
c-debug;     $                       ' cx(',i2,cx(i2),' cx(',i3,cx(i3)
c-debug;                     else
c-debug;                        write(6,9414) iw,'co(m,',i1,jx,it,ir,
c-debug;     $                       co(m,i1,jx,it,ir,kz),'co(m,',i2,
c-debug;     $                       jx,it,ir,co(m,i2,jx,it,ir,kz),
c-debug;     $                       'co(m,',i3,jx,it,ir,
c-debug;     $                       co(m,i3,jx,it,ir,kz),'cxx',cxx,
c-debug;     $                       ' cx(',i1,cx(i1),' cx(',i2,
c-debug;     $                       cx(i2),'cxd(',jx,cxd(jx)
c-debug;                     endif
c-debug;                  enddo
c-debug;                  write(6,9415) b(1),b(2),b(3),'oxx',oxx,
c-debug;     $                 ' ox(',j1,ox(j1),' ox(',j2,ox(j2),
c-debug;     $                 ' ox(',j3,ox(j3),it,ir,opl(it,ir,kz),
c-debug;     $                 'CloO'
c-debug;               endif
c-debug]
            enddo
         enddo
c	      ! else: high-O part of grid: must interpolate O before C:
      else
         do it = k1,k1+ip
            do ir = l1,l1+iq(it-k1+1)
               iw = 0
               do ix = i1,i1+2
                  iw = iw+1
                  if ( j3 .lt. n(m,ix,kz) ) then
                     b(iw) = qchk(is,iw,oxx,co(m,ix,j1,it,ir,kz),
     $                    co(m,ix,j2,it,ir,kz),co(m,ix,j3,it,ir,kz),
     $                    ox(j1),ox(j2),ox(j3))
                  else
                     b(iw) = qchk(is,iw,oxx,co(m,ix,j1,it,ir,kz),
     $                    co(m,ix,j2,it,ir,kz),co(m,ix,mo,it,ir,kz),
     $                    ox(j1),ox(j2),oxd(ix))
                  endif
               enddo
               iw = iw+1
               opl(it,ir,kz) = qchk(is,iw,cxx,b(1),b(2),b(3),
     $              cx(i1),cx(i2),cx(i3))
               is = 1
c-debug[
c-debug;               if ( .not. abs(opl(it,ir,kz)) .le. oudebl .or.
c-debug;     $              .not. abs(b(1)) .le. oudebl .or.
c-debug;     $              .not. abs(b(2)) .le. oudebl .or.
c-debug;     $              .not. abs(b(3)) .le. oudebl .or.
c-debug;     $              ioudeb .gt. 5 ) then
c-debug;                  write(6,9413) m,kz,xxc,xxo,xxc+xxo,
c-debug;     $                 xxco,xc(nc),nc,(n(m,j,kz),j=1,nc)
c-debug;                  koudeb = koudeb+1
c-debug;                  iw = 0
c-debug;                  do ix = i1,i1+2
c-debug;                     iw = iw+1
c-debug;                     if ( j3 .lt. n(m,ix,kz) ) then
c-debug;                        write(6,9414) iw,'co(m,',ix,j1,it,ir,
c-debug;     $                       co(m,ix,j1,it,ir,kz),'co(m,',ix,
c-debug;     $                       j2,it,ir,co(m,ix,j2,it,ir,kz),
c-debug;     $                       'co(m,',ix,j3,it,ir,
c-debug;     $                       co(m,ix,j3,it,ir,kz),
c-debug;     $                       'oxx',oxx,' ox(',j1,ox(j1),
c-debug;     $                       ' ox(',j2,ox(j2),' ox(',j3,ox(j3)
c-debug;                     else
c-debug;                        write(6,9414) iw,'co(m,',ix,j1,it,ir,
c-debug;     $                       co(m,ix,j1,it,ir,kz),'co(m,',ix,
c-debug;     $                       j2,it,ir,co(m,ix,j2,it,ir,kz),
c-debug;     $                       'digo(',m,no-ix,it,ir,
c-debug;     $                       co(m,ix,mo,it,ir,kz),'oxx',oxx,
c-debug;     $                       ' ox(',j1,ox(j1),' ox(',j2,
c-debug;     $                       ox(j2),'oxd(',ix,oxd(ix)
c-debug;                     endif
c-debug;                  enddo
c-debug;                  write(6,9415) b(1),b(2),b(3),'cxx',cxx,
c-debug;     $                 ' cx(',i1,cx(i1),' cx(',i2,cx(i2),
c-debug;     $                 ' cx(',i3,cx(i3),it,ir,opl(it,ir,kz),
c-debug;     $                 'hi-O'
c-debug;               endif
c-debug]
            enddo
         enddo
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine t6rinterp(slr,slt)
c     =============================
c
c     The purpose of this subroutine is to interpolate in logT6 and logR
c     NOTE THAT for 2-dimensional quadratic interpolation, IT DOES NOT MATTER 
c     which direction is interpolated first, horizontal or vertical: the
c     result is the same for interpolated value and derivatives.
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
c COMMON /d_opal_z/ :
c  dkap = derivative of value returned by quadratic interpolation function QDER
c
      common/d_opal_z/ dkap
      save /d_opal_z/
c
      common/bb_opal_z/ xodp,xcdp,xxco,cxx,oxx,
     $     l1,l2,l3,l4,k1,k2,k3,k4,ip,iq(4),kzf,kzg,kzh,kzf2
      save /bb_opal_z/
c-debug[
c-debug;      common/outdeb/ ioudeb,oudebl,koudeb
c-debug]
c
c===
c-debug[
c-debug;      if ( ioudeb .gt. 5 ) then
c-debug;         write(6,'(/"----- t6rinterp( slr=",f10.6,", slt=",f9.6,
c-debug;     $        " ) ----- m",i2," k1:4",4i3," ip,"i2," l1:4",4i3,
c-debug;     $        " iq(1:",i1,")",4i2)')
c-debug;     $        slr, slt, m, k1, k2, k3, k4, ip, l1, l2, l3, l4,
c-debug;     $        ip + 1, ( iq(i), i = 1, ip + 1 )
c-debug;      endif
c-debug]
      iu = 0
      is = 1
      iqp = -9
c			   ! for each of the 3 or 4 T values, interpolate in R:
      do kx = k1, k1 + ip
c
         iu = iu + 1
         iq_at = iq(iu)
c
         if ( iq_at .ne. iqp ) then
            is = is + 1
            call qderNsto( is, iq_at, slr,
     $                     alr(l1), alr(l2), alr(l3), alr(l4) )
            iqp = iq_at
         endif
c							     ! interpolate in R
         call qderNget( is, iq_at, opl(kx,l1,1), opl(kx,l2,1),
     $                  opl(kx,l3,1), opl(kx,l4,1), h(iu), q(iu) )
c-debug[
c-debug;         if ( ioudeb .gt. 3 .or. .not. abs(h(iu)) .le. oudebl .or.
c-debug;     $        .not. abs(q(iu)) .le. oudebl ) then
c-debug;            if ( ioudeb .le. 3 .or. iu .eq. 1 ) write(6,*) ' '
c-debug;            write(6,8912) m,kx,slr,h(iu),q(iu),
c-debug;     $           (kx,j,alr(j),opl(kx,j,1),j=l1,l1+iq(iu))
c-debug; 8912       format(' T6RINTERP(x',i1,',t',i2.2') R',f10.6,
c-debug;     $           ' : K,dKdR =',2g15.7,' <-- it,ir,R,K:',
c-debug;     $           4(i4,i3,f10.6,f11.7))
c-debug;            koudeb = koudeb+1
c-debug;         endif
c-debug]
c
      enddo
c
c  Interpolate in T, getting opacity, T-derivative, interpolated R-derivative
c  (note that calling qderNsto sets up for quadNget as well as qderNget):
c
      call qderNsto( 1, ip, slt, alt(k1), alt(k2), alt(k3), alt(k4) )
c
      call qderNget( 1, ip, h(1), h(2), h(3), h(4), opk(m,1), opk(m,2) )
      opk(m,3) = quadNget( 1, ip, q(1), q(2), q(3), q(4) )
c
      opk(m,4) = opk(m,2) - 3.0 * opk(m,3)
c
c-debug[
c-debug;      if ( .not. abs(opk(m,1)) .le. oudebl .or. ioudeb .gt. 2 ) then
c-debug;         write(6,8913) m, slt,k1,ip,slr,l1,iq(1),iq(2),iq(3),iq(ip+1),
c-debug;     $        opk(m,1),opk(m,2),opk(m,3),opk(m,4),
c-debug;     $        (j,alt(j),h(j-k1+1),q(j-k1+1),j=k1,k1+ip)
c-debug; 8913    format(/' T6RINTERP(x',i1,') logT6',f10.6,
c-debug;     $        ' (',i2,'+',i1,') logR',f10.6,' (',i2,'+',
c-debug;     $        4i1,') logK',g15.7,' DT',f12.7,' DR',f12.7,' DTro',f12.7/
c-debug;     $        '             <-- it,T,K,dKdR',4(i4,f10.6,2f11.7))
c-debug;         koudeb = koudeb+1
c-debug;      endif
c-debug]
      if ( opk(m,1) .gt. 1.e+5 ) then
         write(6,10) m,10.**slt,k1,ip,slr,l1,iq(1),iq(2),iq(3),
     $        iq(ip+1),opk(m,1)
 10      format(' '/' T6RINTERP(m=',i1,') T6=',f15.9,':',i2,'+',i1,
     $        ' logR',f12.7,':',i2,'+',4i1,' logK',e10.3/
     $        '    Error -- interpolation indices out of range:',
     $        ' PLEASE REPORT CONDITIONS')
         stop ' STOP -- T6RINTERP Error: indices out of range. '
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine sngl_cinterp3(ZM,Z0,Z1,ZP,Z,N0,MXNV,VM,V0,V1,VP,
     $                         VF,DF,D2,XH)
c     ===========================================================
c
c  Single-precision version, copied from Potekhin-website program condint.f
c
c Given 4 values of Z and 4 values of V, find VF corresponding to 5th Z
c                                                       Version 23.05.99
c   Output: VF - interpolated value of function
c           DF - interpolated derivative
c           D2 - interpolated second derivative
c           XH - fraction of the path from N0 to N0+1
c
c-sngl;      implicit double precision (A-H), double precision (O-Z)
c
      if (N0.le.0.or.N0.ge.MXNV) stop
     $     ' STOP -- SNGL_CINTERP: N0 out of range '
      X=Z-Z0
      H=Z1-Z0   ! basic interval
      XH=X/H
      if (N0.gt.1) then
         HM=Z0-ZM  ! left adjoint interval
         V01=((V1-V0)/H**2+(V0-VM)/HM**2)/(1./H+1./HM) ! left derivative
      endif
      if (N0.lt.MXNV-1) then
         HP=ZP-Z1 ! right adjoint interval
         V11=((V1-V0)/H**2+(VP-V1)/HP**2)/(1./H+1./HP) ! right derivative
      endif
      if (N0.gt.1.and.N0.lt.MXNV-1) then   ! Cubic interpolation
         C2=3.*(V1-V0)-H*(V11+2.*V01)
         C3=H*(V01+V11)-2.*(V1-V0)
         VF=V0+V01*X+C2*XH**2+C3*XH**3
         DF=V01+(2.*C2*XH+3.*C3*XH**2)/H
         D2=(2.*C2+6.*C3*XH)/H**2
      else if (N0.eq.1) then   ! Quadratic interpolation
         C2=V0-V1+V11*H
         if ( Z .ge. Z0 ) then
            VF=V1-V11*(H-X)+C2*(1.-XH)**2
            DF=V11-2.*C2*(1.-XH)/H
            D2=2.*C2/H**2
         else                       ! or linear extrapolation
            DF = V11-2.*C2/H                ! using quadratic slope at Z0
            VF = V0 + ( Z - Z0 ) * DF
            DF2 = 0.0
         endif
      else  ! N0=MXNV-1
         C2=V1-V0-V01*H
         if ( Z .le. Z1 ) then  ! Quadratic interpolation
            VF=V0+V01*X+C2*XH**2
            DF=V01+2.*C2*XH/H
            D2=2.*C2/H**2
         else                       ! or linear extrapolation
            DF = V01+2.*C2/H                ! using quadratic slope at Z1
            VF = V1 + ( Z - Z1 ) * DF
            DF2 = 0.0
         endif
      endif
      end
c
c******************************************************************************
c
      subroutine qzlog4int( zlogd )
c     =============================
c
c..... this subroutine performs bi-quadratic interpolation of logKappa in the
c      log10(Z_i+zdel) values stored in the array zvint(nz), for each of the
c      relevant positions in the C,O-interpolated opacity matrix opl(nt,nr,nz)
c      (given the input values Z and zdel).  Note that this subroutine uses
c      the quadratic-interpolation function quad.  Depending on the number of
c      Z-values to interpolate among, single-quadratic or linear interpolation
c      may be used instead.  Note that zlogd = log10(Z+zdel).
c
c      NOTE that since errors in the opacities may be large compared to the
c      opacity differences between opacities at adjacent Z-values, quadratic
c      interpolation is forced to be monotonic by using values at adjacent
c      tabulated Z-values as upper and lower limits.  No such restriction is
c      placed on extrapolated values.
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
c COMMON /bb_opal_z/ : some indices & abundances for T6,R and C,O interpolation
c
      common/bb_opal_z/ xodp,xcdp,xxco,cxx,oxx,
     $     l1,l2,l3,l4,k1,k2,k3,k4,ip,iq(4),kzf,kzg,kzh,kzf2
      save /bb_opal_z/
c
c-debug[
c-debug;      common/outdeb/ ioudeb,oudebl,koudeb
c-debug]
c===
c						! bi-quadratic interpolation:
      if ( kzf2 .gt. kzh ) then
c
         call quad4sto( 30, zlogd, zvint(kzf),
     $                  zvint(kzg), zvint(kzh), zvint(kzf2) )
c
         do it = k1, k1 + ip
            do ir = l1, l1 + iq(it-k1+1)
               vkl = opl(it,ir,kzg)
               vkh = opl(it,ir,kzh)
               v0 = max( min(vkl,vkh) , min( max(vkl,vkh) ,
     $              quad4get( 30, opl(it,ir,kzf), vkl,
     $                        vkh, opl(it,ir,kzf2) ) ) )
c-debug[
c-debug;               if ( ioudeb .gt. 4 .or. .not. abs(v0) .le. oudebl ) then
c-debug;                  if ( ioudeb .le. 4 .or. ( it .eq. k1 .and.
c-debug;     $                 ir .eq. l1 ) ) write(6,*) ' '
c-debug;                  write(6,8912) m,it,ir,zlogd,v0,
c-debug;     $                 (j,zvint(j),opl(it,ir,j),j=kzf,kzf2)
c-debug; 8912             format(' QZLOG4INT(x',i1,',t',i2.2,',r',i2.2,') Z',
c-debug;     $                 f10.6,' : K =',g15.7,' <-- iz,Z,K:',
c-debug;     $                 4(i4,f10.6,f11.7))
c-debug;                  koudeb = koudeb+1
c-debug;               endif
c-debug]
               opl(it,ir,1) = v0
            enddo
         enddo
c						! quadratic interpolation:
      else if ( kzh .gt. kzg ) then
c
         v1 = zvint(kzf)
         v2 = zvint(kzg)
         v3 = zvint(kzh)
         call quadsto( 30, zlogd, v1, v2, v3 )
c
         if ( zlogd .le. v2 .and. zlogd .ge. v1 ) then
            do it = k1, k1 + ip
               do ir = l1, l1 + iq(it-k1+1)
                  vkl = opl(it,ir,kzf)
                  vkh = opl(it,ir,kzg)
                  v0 = max( min(vkl,vkh) , min( max(vkl,vkh) ,
     $                 quadget( 30, vkl, vkh, opl(it,ir,kzh) ) ) )
c-debug[
c-debug;                  if ( ioudeb .gt. 4 .or.
c-debug;     $                 .not. abs(v0) .le. oudebl ) then
c-debug;                     if ( ioudeb .le. 4 .or. ( it .eq. k1 .and.
c-debug;     $                    ir .eq. l1 ) ) write(6,*) ' '
c-debug;                     write(6,8912) m,it,ir,zlogd,v0,
c-debug;     $                    (j,zvint(j),opl(it,ir,j),j=kzf,kzh)
c-debug;                     koudeb = koudeb+1
c-debug;                  endif
c-debug]
                  opl(it,ir,1) = v0
               enddo
            enddo
         else if ( zlogd .ge. v2 .and. zlogd .le. v3 ) then
            do it = k1, k1 + ip
               do ir = l1, l1 + iq(it-k1+1)
                  vkl = opl(it,ir,kzg)
                  vkh = opl(it,ir,kzh)
                  v0 = max( min(vkl,vkh) , min( max(vkl,vkh) ,
     $                 quadget( 30, opl(it,ir,kzf), vkl, vkh ) ) )
c-debug[
c-debug;                  if ( ioudeb .gt. 4 .or.
c-debug;     $                 .not. abs(v0) .le. oudebl ) then
c-debug;                     if ( ioudeb .le. 4 .or. ( it .eq. k1 .and.
c-debug;     $                    ir .eq. l1 ) ) write(6,*) ' '
c-debug;                     write(6,8912) m,it,ir,zlogd,v0,
c-debug;     $                    (j,zvint(j),opl(it,ir,j),j=kzf,kzh)
c-debug;                     koudeb = koudeb+1
c-debug;                  endif
c-debug]
                  opl(it,ir,1) = v0
               enddo
            enddo
         else
            do it = k1, k1 + ip
               do ir = l1, l1 + iq(it-k1+1)
                  v0 = quadget( 30, opl(it,ir,kzf),
     $                          opl(it,ir,kzg), opl(it,ir,kzh) )
c-debug[
c-debug;                  if ( ioudeb .gt. 4 .or.
c-debug;     $                 .not. abs(v0) .le. oudebl ) then
c-debug;                     if ( ioudeb .le. 4 .or. ( it .eq. k1 .and.
c-debug;     $                    ir .eq. l1 ) ) write(6,*) ' '
c-debug;                     write(6,8912) m,it,ir,zlogd,v0,
c-debug;     $                    (j,zvint(j),opl(it,ir,j),j=kzf,kzh)
c-debug;                     koudeb = koudeb+1
c-debug;                  endif
c-debug]
                  opl(it,ir,1) = v0
               enddo
            enddo
         endif
c						! linear interpolation:
      else if ( kzg .gt. kzf ) then
c
         f = ( zvint(kzg) - zlogd )
     $        / ( zvint(kzg) - zvint(kzf) )
         omf = 1. - f
         do it = k1, k1 + ip
            do ir = l1, l1 + iq(it-k1+1)
               v0 = f * opl(it,ir,kzf) + omf * opl(it,ir,kzg)
c-debug[
c-debug;               if ( ioudeb .gt. 4 .or. .not. abs(v0) .le. oudebl ) then
c-debug;                  if ( ioudeb .le. 4 .or. ( it .eq. k1 .and.
c-debug;     $                 ir .eq. l1 ) ) write(6,*) ' '
c-debug;                  write(6,8912) m,it,ir,zlogd,v0,
c-debug;     $                 (j,zvint(j),opl(it,ir,j),j=kzf,kzg)
c-debug;                  koudeb = koudeb+1
c-debug;               endif
c-debug]
                  opl(it,ir,1) = v0
            enddo
         enddo
c						! or no interpolation:
      else if ( kzf .ne. 1 ) then
c
         do it = k1, k1 + ip
            do ir = l1, l1 + iq(it-k1+1)
               opl(it,ir,1) = opl(it,ir,kzf)
            enddo
         enddo
c
      endif
c
      return
      end
c
c******************************************************************************
c
      function quadsl(ic,i,x,y1,y2,y3,x1,x2,x3)
c     =========================================
c
c..... this function performs a quadratic interpolation, trying to avoid
c      spurious wiggles at point where the slope changes by a large amount
c
      parameter ( small_1m6=1.e-6 )
c
c  Storage for x,dx_i values that need not be computed on each call (see "ic");
c  NOTE that this same storage is used by all of QUADSL, QDERSL
c
      common/c_quadsl_opal_z/ xo21(10), xo32(10), x01(10), x02(10),
     $     x03(10), x0230o32(10), x0202o32(10), x023021o3231(10),
     $     x0203o31(10), x0201o31(10), x0201o21(10), x0202o21(10),
     $     x020132o2131(10), ixvs2(10)
      save /c_quadsl_opal_z/
c___
      dimension xx(6)
c===
      xx(5) = y2
c			  ! quad may be called many times with same x,x1,x2,x3;
c			    ! compute & store X-deltas only if flag ic says so:
      if ( ic .eq. 0 ) then
c
         call quadslsto( i, x, x1, x2, x3 )
c
c-debug[
      else
c
         xx(4) = x
         xx(2) = x2
c
         if ( xx(4) .eq. x2 ) then
c
            if ( ixvs2(i) .ne. 0 ) then
               write(6,100) ixvs2(i), 0, i, x, x1, x2, x3
 100           format(' QUADSL Error: ixvs2(i) =',i3,
     $              ' [should be',i3,']: from i =',i3,
     $              ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
               stop ' STOP -- QUADSL Error: bad ixvs2(i) .ne. 0 '
            endif
c
         else
c
            xx(1) = x1
            xx(3) = x3
c
            if ( abs( xo21(i) * ( xx(2) - xx(1) ) - 1.0 ) .gt.
     $           small_1m6 ) then
               write(6,110) 'xo21', xo21(i), 1.0 / ( xx(2) - xx(1) ),
     $              i, x, x1, x2, x3
 110           format(' QUADSL Error: ',a,'(i) =',1p,e15.7,
     $              ' [should be ',e15.7,']: from i =',i3,
     $              ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
               stop ' STOP -- QUADSL Error: bad xo21(i) '
            else if ( abs( xo32(i) * ( xx(3) - xx(2) ) - 1.0 ) .gt.
     $              small_1m6 ) then
               write(6,110) 'xo32', xo32(i), 1.0 / ( xx(3) - xx(2) ),
     $              i, x, x1, x2, x3
               stop ' STOP -- QUADSL Error: bad xo32(i) '
            else if ( abs( xx(4) - xx(2) - x02(i) ) .gt.
     $              small_1m6 * x02(i) ) then
               write(6,110) 'x02', x02(i), xx(4) - xx(2),
     $              i, x, x1, x2, x3
               stop ' STOP -- QUADSL Error: bad x02(i) '
            endif
c
            if ( xx(1) .lt. xx(3) ) then
               if ( xx(4) .lt. xx(2) ) then
                  if ( ixvs2(i) .ne. -1 ) then
                     write(6,100) ixvs2(i), -1, i, x, x1, x2, x3
                     stop ' STOP -- QUADSL Error: bad ixvs2(i) .ne. -1'
                  endif
               else if ( ixvs2(i) .ne. 1 ) then
                  write(6,100) ixvs2(i), 1, i, x, x1, x2, x3
                  stop ' STOP -- QUADSL Error: bad ixvs2(i) .ne. 1 '
               endif
            else if ( xx(4) .gt. xx(2) ) then
               if ( ixvs2(i) .ne. -1 ) then
                  write(6,100) ixvs2(i), -1, i, x, x1, x2, x3
                  stop ' STOP -- QUADSL Error: bad ixvs2(i) .ne. -1 '
               endif
            else if ( ixvs2(i) .ne. 1 ) then
               write(6,100) ixvs2(i), 1, i, x, x1, x2, x3
               stop ' STOP -- QUADSL Error: bad ixvs2(i) .ne. 1 '
            endif
c
         endif
c-debug]
      endif
c
      if ( ixvs2(i) .eq. 0 ) then
         quadsl = xx(5)
         return
      endif
c
      xx(4) = y1
      xx(6) = y3
      s21 = ( xx(5) - xx(4) ) * xo21(i)
      s32 = ( xx(6) - xx(5) ) * xo32(i)
      as21 = abs( s21 )
      as32 = abs( s32 )
c
      if ( 6.0 * as21 .le. as32 ) then
c
         if ( ixvs2(i) .le. 0 ) then
            quadsl = x02(i) * s21 + xx(5)
         else
            quadsl = x0230o32(i) * s21 + x0202o32(i) * s32 + xx(5)
         endif
c
      else if ( 2.0 * as21 .lt. as32 ) then
c
         omf_ds = ( 1.5 - as32 / ( 4.0 * as21 ) ) * ( s32 - s21 )
         if ( ixvs2(i) .le. 0 ) then
            quadsl = omf_ds * x0201o31(i) + x01(i) * s21 + xx(4)
         else
            quadsl = x0230o32(i) * s21 + x0202o32(i) * s32
     $           + omf_ds * x023021o3231(i) + xx(5)
         endif
c
      else if ( 2.0 * as32 .ge. as21 ) then
c
         quadsl = x0201o31(i) * s32 - x0203o31(i) * s21 + xx(5)
c
      else if ( 6.0 * as32 .gt. as21 ) then
c
         omf_ds = ( 1.5 - as21 / ( 4.0 * as32 ) ) * ( s32 - s21 )
         if ( ixvs2(i) .ge. 0 ) then
            quadsl = omf_ds * x0203o31(i) + x03(i) * s32 + xx(6)
         else
            quadsl = x0201o21(i) * s32 - x0202o21(i) * s21
     $           - omf_ds * x020132o2131(i) + xx(5)
         endif
c
      else if ( ixvs2(i) .ge. 0 ) then
         quadsl = x02(i) * s32 + xx(5)
      else
         quadsl = x0201o21(i) * s32 - x0202o21(i) * s21 + xx(5)
      endif
c
      return
      end
c
c******************************************************************************
c
      function qdersl(ic,i,x,y1,y2,y3,x1,x2,x3)
c     =========================================
c
c..... this function performs a quadratic interpolation, trying to avoid
c      spurious wiggles at point where the slope changes by a large amount;
c      it is identical to the function quadsl, except that it also computes
c      the derivative dkap of the quadratic at the given position x
c
      parameter ( small_1m6=1.e-6 )
c
c  COMMON /d_opal_z/ : dkap returns the derivative (in interpolation-direction)
c
      common /d_opal_z/ dkap
      save /d_opal_z/
c
c  Storage for x,dx_i values that need not be computed on each call (see "ic");
c  NOTE that this same storage is used by all of QUADSL, QDERSL
c
      common/c_quadsl_opal_z/ xo21(10), xo32(10), x01(10), x02(10),
     $     x03(10), x0230o32(10), x0202o32(10), x023021o3231(10),
     $     x0203o31(10), x0201o31(10), x0201o21(10), x0202o21(10),
     $     x020132o2131(10), ixvs2(10)
      save /c_quadsl_opal_z/
c
      common/c_qdersl_opal_z/ x01o31(10), x30o31(10), x30p20o31(10),
     $     x02p01o31(10), x30p20o32(10), x02o32two(10), x02p01o21(10),
     $     x30p2021o3231(10), x02p03o31(10), x02o21two(10),
     $     x02p0132o2131(10)
      save /c_qdersl_opal_z/
c___
      dimension xx(6)
c===
c			  ! qder may be called many times with same x,x1,x2,x3;
c			    ! compute & store X-deltas only if flag ic says so:
      if ( ic .eq. 0 ) then
c
         call qderslsto( i, x, x1, x2, x3 )
c
c-debug[
      else
c
         xx(1) = x1
         xx(2) = x2
         xx(3) = x3
         xx(4) = x
c
         if ( abs( xo21(i) * ( xx(2) - xx(1) ) - 1.0 ) .gt.
     $        small_1m6 ) then
            write(6,110) 'xo21', xo21(i), 1.0 / ( xx(2) - xx(1) ),
     $           i, x, x1, x2, x3
 110        format(' QDERSL Error: ',a,'(i) =',1p,e15.7,
     $           ' [should be ',e15.7,']: from i =',i3,
     $           ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
            stop ' STOP -- QDERSL Error: bad xo21(i) '
         else if ( abs( xo32(i) * ( xx(3) - xx(2) ) - 1.0 ) .gt.
     $           small_1m6 ) then
            write(6,110) 'xo32', xo32(i), 1.0 / ( xx(3) - xx(2) ),
     $           i, x, x1, x2, x3
            stop ' STOP -- QDERSL Error: bad xo32(i) '
         endif
c
         if ( xx(4) .eq. xx(2) ) then
c
            if ( ixvs2(i) .ne. 0 ) then
               write(6,100) ixvs2(i), 0, i, x, x1, x2, x3
 100           format(' QDERSL Error: ixvs2(i) =',i3,
     $              ' [should be',i3,']: from i =',i3,
     $              ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
               stop ' STOP -- QDERSL Error: bad ixvs2(i) .ne. 0 '
            endif
c
         else
c
            if ( abs( xx(4) - xx(2) - x02(i) ) .gt.
     $           small_1m6 * x02(i) ) then
               write(6,110) 'x02', x02(i), xx(4) - xx(2),
     $              i, x, x1, x2, x3
               stop ' STOP -- QDERSL Error: bad x02(i) '
            endif
c
            if ( xx(1) .lt. xx(3) ) then
               if ( xx(4) .lt. xx(2) ) then
                  if ( ixvs2(i) .ne. -1 ) then
                     write(6,100) ixvs2(i), -1, i, x, x1, x2, x3
                     stop ' STOP -- QDERSL Error: bad ixvs2(i) .ne. -1'
                  endif
               else if ( ixvs2(i) .ne. 1 ) then
                  write(6,100) ixvs2(i), 1, i, x, x1, x2, x3
                  stop ' STOP -- QDERSL Error: bad ixvs2(i) .ne. 1 '
               endif
            else if ( xx(4) .gt. xx(2) ) then
               if ( ixvs2(i) .ne. -1 ) then
                  write(6,100) ixvs2(i), -1, i, x, x1, x2, x3
                  stop ' STOP -- QDERSL Error: bad ixvs2(i) .ne. -1 '
               endif
            else if ( ixvs2(i) .ne. 1 ) then
               write(6,100) ixvs2(i), 1, i, x, x1, x2, x3
               stop ' STOP -- QDERSL Error: bad ixvs2(i) .ne. 1 '
            endif
         endif
c-debug]
      endif
c
      xx(4) = y1
      xx(5) = y2
      xx(6) = y3
      s21 = ( xx(5) - xx(4) ) * xo21(i)
      s32 = ( xx(6) - xx(5) ) * xo32(i)
      as21 = abs( s21 )
      as32 = abs( s32 )
c
      if ( ixvs2(i) .eq. 0 ) then
         if ( 6.0 * as21 .le. as32 ) then
            dkap = s21
         else if ( 2.0 * as21 .lt. as32 ) then
            omf = 1.5 - as32 / ( 4.0 * as21 )
            dkap = s21 - omf * x01o31(i) * ( s21 - s32 )
         else if ( 2.0 * as32 .ge. as21 ) then
            dkap = x30o31(i) * s21 + x01o31(i) * s32
         else if ( 6.0 * as32 .gt. as21 ) then
            omf = 1.5 - as21 / ( 4.0 * as32 )
            dkap = s32 - omf * x30o31(i) * ( s32 - s21 )
         else
            dkap = s32
         endif
         qdersl = xx(5)
         return
      endif
c
      if ( 6.0 * as21 .le. as32 ) then
c
         if ( ixvs2(i) .le. 0 ) then
            qdersl = x02(i) * s21 + xx(5)
            dkap = s21
         else
            qdersl = x0230o32(i) * s21 + x0202o32(i) * s32 + xx(5)
            dkap = x30p20o32(i) * s21 + x02o32two(i) * s32
         endif
c
      else if ( 2.0 * as21 .lt. as32 ) then
c
         omf_ds = ( 1.5 - as32 / ( 4.0 * as21 ) ) * ( s32 - s21 )
         if ( ixvs2(i) .le. 0 ) then
            qdersl = omf_ds * x0201o31(i) + x01(i) * s21 + xx(4)
            dkap = s21 + omf_ds * x02p01o31(i)
         else
            qdersl = x0230o32(i) * s21 + x0202o32(i) * s32
     $           + omf_ds * x023021o3231(i) + xx(5)
            dkap = x30p20o32(i) * s21 + x02o32two(i) * s32
     $           + omf_ds * x30p2021o3231(i)
         endif
c
      else if ( 2.0 * as32 .ge. as21 ) then
c
         qdersl = x0201o31(i) * s32 - x0203o31(i) * s21 + xx(5)
         dkap = x30p20o31(i) * s21 + x02p01o31(i) * s32
c
      else if ( 6.0 * as32 .gt. as21 ) then
c
         omf_ds = ( 1.5 - as21 / ( 4.0 * as32 ) ) * ( s32 - s21 )
         if ( ixvs2(i) .ge. 0 ) then
            qdersl = omf_ds * x0203o31(i) + x03(i) * s32 + xx(6)
            dkap = s32 + omf_ds * x02p03o31(i)
         else
            qdersl = x0201o21(i) * s32 - x0202o21(i) * s21
     $           - omf_ds * x020132o2131(i) + xx(5)
            dkap = x02p01o21(i) * s32 - x02o21two(i) * s21
     $           - omf_ds * x02p0132o2131(i)
         endif
c
      else if ( ixvs2(i) .ge. 0 ) then
         qdersl = x02(i) * s32 + xx(5)
         dkap = s32
      else
         qdersl = x0201o21(i) * s32 - x0202o21(i) * s21 + xx(5)
         dkap = x02p01o21(i) * s32 - x02o21two(i) * s21
      endif
c
      return
      end
c
c******************************************************************************
c
      function qchksl(ic,i,x,y1,y2,y3,x1,x2,x3)
c     =========================================
c
c..... this function calls quadsl(ic,i,x,y1,y2,y3,x1,x2,x3) to perform a
c      quadratic interpolation, but first checks whether any pair of x-values
c      is too close together to make a quadratic interpolation reasonable;
c      if this is the case, something more nearly linear is used instead.
c
c  QCHKSL is used only for Ferguson et al. 2005 molecular opacities at the
c  highest X-interval; thus one can assume x1 < x2 and ( x2 < x3 or x2 = x3 ).
c
      parameter ( ratbeg=0.08, ratful=0.04, ratdel=1./(ratbeg-ratful) )
c
      common /c_qchksl_opal_z/ x01o21p31(10), facq(10), omfq(10),
     $     iokq(10)
      save /c_qchksl_opal_z/
c___
      dimension xx(3), yy(3)
c===
c			! qchksl may be called many times with same x,x1,x2,x3;
c			    ! compute & store X-deltas only if flag ic says so:
      if ( ic .eq. 0 ) then
c
         call qchkslsto( i, x, x1, x2, x3 )
c-debug[
      else
c
         xx(1) = x1
         xx(2) = x2
         xx(3) = x3
         dxrat = abs( xx(3) - xx(2) ) / abs( xx(3) - xx(1) )
         if ( dxrat .ge. ratbeg ) then
            if ( iokq(i) .ne. 1 ) then
               write(6,100) iokq(i), 1, i, x, x1, x2, x3
 100           format(' QCHKSL Error: iokq(i) =',i3,
     $              ' [should be',i3,']: from i =',i3,
     $              ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
               stop ' STOP -- QCHKSL Error: bad iokq(i) .ne. 1 '
            endif
         else
            if ( abs( x01o21p31(i) - ( x - xx(1) )
     $           / ( ( xx(2) - xx(1) ) + ( xx(3) - xx(1) ) ) ) .gt.
     $           small_1m6 ) then
               write(6,110) 'x01o21p31', x01o21p31(i), +( x - xx(1) )
     $              / ( ( xx(2) - xx(1) ) + ( xx(3) - xx(1) ) ),
     $              i, x, x1, x2, x3
 110           format(' QCHKSL Error: ',a,'(i) =',1p,e15.7,
     $              ' [should be ',e15.7,']: from i =',i3,
     $              ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
               stop ' STOP -- QCHKSL Error: bad x01o21p31(i) '
            endif
            if ( dxrat .gt. ratful ) then
               if ( iokq(i) .ne. 0 ) then
                  write(6,100) iokq(i), 1, i, x, x1, x2, x3
                  stop ' STOP -- QCHKSL Error: bad iokq(i) .ne. 0 '
               else if ( abs( facq(i) - (dxrat-ratful)*ratdel ) .gt.
     $                 small_1m6 ) then
                  write(6,110) 'facq', facq(i), +(dxrat-ratful)*ratdel,
     $                 i, x, x1, x2, x3
                  stop ' STOP -- QCHKSL Error: bad facq(i) '
               endif
            else if ( iokq(i) .ne. -1 ) then
               write(6,100) iokq(i), -1, i, x, x1, x2, x3
               stop ' STOP -- QCHKSL Error: bad iokq(i) .ne. -1 '
            endif
         endif
c-debug]
      endif
c
      if ( iokq(i) .gt. 0 ) then
         qchksl = quadsl(1,i,x,y1,y2,y3,x1,x2,x3)
      else
         yy(1) = y1
         yy(2) = y2
         yy(3) = y3
         if ( iokq(i) .lt. 0 ) then
            qchksl = yy(1) + x01o21p31(i)
     $           * ( ( yy(2) - yy(1) ) + ( yy(3) - yy(1) ) )
         else
            qchksl = omfq(i) * ( yy(1) + x01o21p31(i)
     $           * ( ( yy(2) - yy(1) ) + ( yy(3) - yy(1) ) ) )
     $           + facq(i) * quadsl(1,i,x,y1,y2,y3,x1,x2,x3)
         endif
      endif
c
      return
      end
c
c******************************************************************************
c
      function quad(ic,i,x,y1,y2,y3,x1,x2,x3)
c     =======================================
c
c..... this function performs a quadratic interpolation.
c
      parameter ( small_1m6=1.e-6 )
c
c  Storage for x,dx_i values that need not be computed on each call (see "ic");
c  NOTE that this same storage is used by all of QUAD, QDER, and QCHK.
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c___
      dimension xx(6)
c===
      xx(5) = y2
c			  ! quad may be called many times with same x,x1,x2,x3;
c			    ! compute & store X-deltas only if flag ic says so:
      if ( ic .eq. 0 ) then
         call quadsto( i, x, x1, x2, x3 )
c-debug[
      else
         xx(4) = x
         xx(1) = x1
         xx(2) = x2
         xx(3) = x3
         xx(6) = ( xx(4) - xx(2) ) / ( xx(3) - xx(1) )
         if ( abs( a21(i) - xx(6) * ( xx(3) - xx(4) )
     $        / ( xx(2) - xx(1) ) ) .gt. small_1m6 ) then
            write(6,110) 'a21', a21(i), xx(6) * ( xx(3) - xx(4) )
     $           / ( xx(2) - xx(1) ), i, x, x1, x2, x3
 110        format(' QUAD Error: ',a,'(i) =',1p,e15.7,
     $           ' [should be ',e15.7,']: from i =',i3,
     $           ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
            stop ' STOP -- QUAD Error: bad a21(i) '
         else if ( abs( a32(i) - xx(6) * ( xx(4) - xx(1) )
     $           / ( xx(3) - xx(2) ) ) .gt. small_1m6 ) then
            write(6,110) 'a32', a32(i), xx(6) * ( xx(4) - xx(1) )
     $           / ( xx(3) - xx(2) ), i, x, x1, x2, x3
            stop ' STOP -- QUAD Error: bad a32(i) '
         endif
c-debug]
      endif
c
      quad = a21(i) * ( xx(5) - y1 ) + a32(i) * ( y3 - xx(5) ) + xx(5)
      return
      end
c
c******************************************************************************
c
      function qder(ic,i,x,y1,y2,y3,x1,x2,x3)
c     =======================================
c
c..... this function performs a quadratic interpolation; it is identical to the
c      function quad, except that it also computes the derivative dkap of the
c      quadratic at the given position x (see  common /d_opal_z/  below).
c
      parameter ( small_1m6=1.e-6 )
c
c  COMMON /d_opal_z/ : dkap returns the derivative (in interpolation-direction)
c
      common /d_opal_z/ dkap
      save /d_opal_z/
c
c  Storage for x,dx_i values that need not be computed on each call (see "ic");
c  NOTE that this same storage is used by all of QUAD, QDER, and QCHK.
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c___
      dimension xx(9)
c===
      xx(5) = y2
      xx(6) = xx(5) - y1
      xx(7) = y3 - xx(5)
c			  ! qder may be called many times with same x,x1,x2,x3;
c			    ! compute & store X-deltas only if flag ic says so:
      if ( ic .eq. 0 ) then
         call qdersto( i, x, x1, x2, x3 )
c-debug[
      else
         xx(4) = x
         xx(1) = x1
         xx(2) = x2
         xx(3) = x3
         xx(8) = 1.0 / ( ( xx(3) - xx(1) ) * ( xx(2) - xx(1) ) )
         xx(9) = 1.0 / ( ( xx(3) - xx(1) ) * ( xx(3) - xx(2) ) )
         if ( abs( a21(i) - ( xx(4) - xx(2) )
     $        * ( xx(3) - xx(4) ) * xx(8) ) .gt. small_1m6 ) then
            write(6,110) 'a21', a21(i), +( xx(4) - xx(2) )
     $           * ( xx(3) - xx(4) ) * xx(8), i, x, x1, x2, x3
 110        format(' QDER Error: ',a,'(i) =',1p,e15.7,
     $           ' [should be ',e15.7,']: from i =',i3,
     $           ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
            stop ' STOP -- QDER Error: bad a21(i) '
         else if ( abs( a32(i) - ( xx(4) - xx(2) )
     $           * ( xx(4) - xx(1) ) * xx(9) ) .gt. small_1m6 ) then
            write(6,110) 'a32', a32(i), +( xx(4) - xx(2) )
     $           * ( xx(4) - xx(1) ) * xx(9), i, x, x1, x2, x3
            stop ' STOP -- QDER Error: bad a32(i) '
         endif
c-debug]
      endif
c
      dkap = d21(i) * xx(6) + d32(i) * xx(7)
      qder = a21(i) * xx(6) + a32(i) * xx(7) + xx(5)
      return
      end
c
c******************************************************************************
c
      function qchk(ic,i,x,y1,y2,y3,x1,x2,x3)
c     =======================================
c
c..... this function calls quad(ic,i,x,y1,y2,y3,x1,x2,x3) to perform a
c      quadratic interpolation, but first checks whether any pair of x-values
c      is too close together to make a quadratic interpolation reasonable;
c      if this is the case, something more nearly linear is used instead.
c      Also, for C or O < 0.0 (i.e., x < x1 < x3, as can occur for CNO-depleted
c      matter), linear extrapolation is used.  Note that opacity derivatives
c      are not needed for C-O interpolation, and are not computed.
c
c QCHK is used for interpolating OPAL opacities in C and O, and (when X is
c   large) for interpolating Ferguson et al. 2005 molecular opacities in X.
c
c QCHK is really neaded only for Z slightly less than 0.02, 0.05, or 0.07, or
c   for 0.03 < Z < 0.05 or 0.08 < Z < 0.1, where the C+O=1-X-Z line for one
c   or more of the X-values passes very close above one of the usual C-O grid
c   points; this can result in quadratic interpolation errors in the opacities
c   of more than an order of magnitude.  The solution is to avoid using a
c   quadratic fit if two of the three x-values are too close together.
c
c      NOTE that if a quadratic is fitted through 3 points with a large
c      interval R=(x2-x1) with values differing by D=(y2-y1), next to a much
c      smaller interval r=(x3-x2) with values differing by d=(y3-y2), and
c      the close-together points y2 and y3 have a relative error E, then
c      at the middle of the large interval R this error is magnified by
c      a factor of (1/4)(R/r).  At the middle of the interval R, the
c      difference between a linear and a quadratic is (1/4)[D-(R/r)d];
c      if this is less than the magnified error (1/4)(R/r)E, i.e.,
c      if E > | (r/R)D - d | , then the linear fit is better.  For Z < 0.04,
c      the opacity errors should be a few percent, and the RELATIVE error
c      bewteen adjacent nearly-identical compositions may be much smaller:
c      for example, in G91x35z03, compare the following tables:
c TABLE #  7  Grvss'91 (12/92) X=0.3500 Y=0.0200 Z=0.0300 dXc=0.6000 dXo=0.0000
c TABLE # 15  Grvss'91 (12/92) X=0.3500 Y=0.0100 Z=0.0300 dXc=0.6000 dXo=0.0100
c TABLE # 16  Grvss'91 (12/92) X=0.3500 Y=0.0000 Z=0.0300 dXc=0.6100 dXo=0.0100
c      Systematic opacity differences between these tables (due to differences
c      between their compositions) appear to be of order 0.01 or less in
c      general, and RANDOM errors in these differences appear to be, at most,
c      of order 0.001 (i.e., 0.2 percent).  Here in QCHK, a quadratic-error
c      magnification of nearly 3 is allowed (R/r=11.5) before beginning to
c      switch over to linear interpolation; the switch-over is complete at
c      R/r=24.  The ratios used in the code below are actually r/(r+R).
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( ratbeg=0.08, ratful=0.04, ratdel=1./(ratbeg-ratful) )
c
c  Storage for factors that need not be computed on each call;
c  NOTE that QCHK calls QUAD, and may also call QCHKSTO which calls QUADSTO.
c
      common/c_qchk_opal_z/ facq(30),dxinvq(30),omfq(30),
     $     iokq(30),iloq(30),i1q(30),i2q(30),lin(30)
      save /c_qchk_opal_z/
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c
      dimension xx(3), yy(3), r(3)
c
      if ( ic .eq. 0 ) then
c
         call qchksto( i, x, x1, x2, x3 )
c
c-debug[
      else
c
         xx(1) = x1
         xx(2) = x2
         xx(3) = x3
c
         if ( x .lt. xx(1) .and. xx(3) - xx(1) .gt. small_1m6 ) then
c
            xloq = max( xx(2) - xx(1) , small_1m6 )
            omf = max( 0.0 , min( 1.0 , ( xx(3) - xx(1) ) / xloq ) )
            if ( lin(i) .ne. 1 ) then
               write(6,100) 'lin', lin(i), 1, i, x, x1, x2, x3
 100           format(' QCHK Error: ',a,'(i) =',i3,
     $              ' [should be',i3,']: from i =',i3,
     $              ' x =',1p,e15.7,' x1,2,3 =',3e15.7)
               stop ' STOP -- QCHK Error: bad lin(i) .ne. 1 '
            else if ( abs( omfq(i) - omf * ( x - xx(1) )
     $              / ( xx(3) - xx(1) ) ) .gt. small_1m6 ) then
               write(6,110) 'omfq', omfq(i), omf * ( x - xx(1) )
     $              / ( xx(3) - xx(1) ), i, lin(i), x, x1, x2, x3
 110           format(' QCHK Error: ',a,'(i) =',1p,e15.7,
     $              ' [should be ',e15.7,']: from i =',i3,
     $              ' lin(i) =',i3,' x =',1p,e15.7,' x1,2,3 =',3e15.7)
               stop ' STOP -- QCHK Error: bad omfq(i) '
            else if ( abs( facq(i) - ( 1. - omf )
     $              * ( x - xx(1) ) / xloq ) .gt. small_1m6 ) then
               write(6,110) 'facq', facq(i), +( 1. - omf )
     $              * ( x - xx(1) ) / xloq, i, lin(i), x, x1, x2, x3
               stop ' STOP -- QCHK Error: bad facq(i) '
            endif
c
         else if ( lin(i) .ne. 0 ) then
c
            write(6,100) 'lin', lin(i), 0, i, x, x1, x2, x3
            stop ' STOP -- QCHK Error: bad lin(i) .ne. 0 '
c
         else
c
            r(1) = abs( xx(3) - xx(2) )
            r(2) = abs( xx(3) - xx(1) )
            r(3) = abs( xx(2) - xx(1) )
c
            dxrat = min(r(1),r(2),r(3))/max(r(1),r(2),r(3))
c
            if ( dxrat .ge. ratbeg ) then
               tmp = ( x - xx(2) ) / ( xx(3) - xx(1) )
               if ( iokq(i) .ne. 1 ) then
                  write(6,100) 'iokq', iokq(i), 1, i, x, x1, x2, x3
                  stop ' STOP -- QCHK Error: bad iokq(i) .ne. 1 '
               else if ( abs( a21(i) - tmp * ( xx(3) - x )
     $                 / ( xx(2) - xx(1) ) ) .gt. small_1m6 ) then
                  write(6,110) 'a21', a21(i), tmp * ( xx(3) - x )
     $                 / ( xx(2) - xx(1) ), i, lin(i), x, x1, x2, x3
                  stop ' STOP -- QCHK Error: bad a21(i) '
               else if ( abs( a32(i) - tmp * ( x - xx(1) )
     $                 / ( xx(3) - xx(2) ) ) .gt. small_1m6 ) then
                  write(6,110) 'a32', a32(i), tmp * ( x - xx(1) )
     $                 / ( xx(3) - xx(2) ), i, lin(i), x, x1, x2, x3
               endif
            else
               if ( r(3) .lt. min(r(1),r(2)) ) then
                  if ( iloq(i) .ne. 3 ) then
                     write(6,100) 'iloq', iloq(i), 3, i, x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad iloq(i) .ne. 3 '
                  else if ( i1q(i) .ne. 1 ) then
                     write(6,100) 'i1q', i1q(i), 1, i, x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad i1q(i) .ne. 1 '
                  else if ( i2q(i) .ne. 2 ) then
                     write(6,100) 'i2q', i2q(i), 2, i, x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad i2q(i) .ne. 2 '
                  endif
               else if ( r(2) .lt. r(1) ) then
                  if ( iloq(i) .ne. 2 ) then
                     write(6,100) 'iloq', iloq(i), 2, i, x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad iloq(i) .ne. 2 '
                  else if ( i1q(i) .ne. 3 ) then
                     write(6,100) 'i1q', i1q(i), 3, i, x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad i1q(i) .ne. 3 '
                  else if ( i2q(i) .ne. 1 ) then
                     write(6,100) 'i2q', i2q(i), 1, i, x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad i2q(i) .ne. 1 '
                  endif
               else if ( iloq(i) .ne. 1 ) then
                  write(6,100) 'iloq', iloq(i), 1, i, x, x1, x2, x3
                  stop ' STOP -- QCHK Error: bad iloq(i) .ne. 1 '
               else if ( i1q(i) .ne. 2 ) then
                  write(6,100) 'i1q', i1q(i), 2, i, x, x1, x2, x3
                  stop ' STOP -- QCHK Error: bad i1q(i) .ne. 2 '
               else if ( i2q(i) .ne. 3 ) then
                  write(6,100) 'i2q', i2q(i), 3, i, x, x1, x2, x3
                  stop ' STOP -- QCHK Error: bad i2q(i) .ne. 3 '
               endif
               if ( abs( dxinvq(i) - ( x - xx(iloq(i)) )
     $              / ( ( xx(i1q(i)) + xx(i2q(i)) ) * 0.5
     $              - xx(iloq(i)) ) ) .gt. small_1m6 ) then
                  write(6,110) 'dxinvq', dxinvq(i),
     $                 +( x - xx(iloq(i)) )
     $                 / ( ( xx(i1q(i)) + xx(i2q(i)) ) * 0.5
     $                 - xx(iloq(i)) ), i, lin(i), x, x1, x2, x3
                  stop ' STOP -- QCHK Error: bad dxinvq(i) '
               endif
               if ( dxrat .gt. ratful ) then
                  tmp = ( x - xx(2) ) / ( xx(3) - xx(1) )
                  if ( iokq(i) .ne. 0 ) then
                     write(6,100) 'iokq', iokq(i), 0, i, x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad iokq(i) .ne. 0 '
                  else if ( abs( facq(i) - ( dxrat - ratful )
     $                    * ratdel ) .gt. small_1m6 ) then
                     write(6,110) 'facq', facq(i), +( dxrat - ratful )
     $                    * ratdel, i, lin(i), x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad facq(i) '
                  else if ( abs( a21(i) - tmp * ( xx(3) - x )
     $                    / ( xx(2) - xx(1) ) ) .gt. small_1m6 ) then
                     write(6,110) 'a21', a21(i), tmp * ( xx(3) - x )
     $                    / ( xx(2) - xx(1) ), i, lin(i), x, x1, x2, x3
                     stop ' STOP -- QCHK Error: bad a21(i) '
                  else if ( abs( a32(i) - tmp * ( x - xx(1) )
     $                    / ( xx(3) - xx(2) ) ) .gt. small_1m6 ) then
                     write(6,110) 'a32', a32(i), tmp * ( x - xx(1) )
     $                    / ( xx(3) - xx(2) ), i, lin(i), x, x1, x2, x3
                  endif
               else if ( iokq(i) .ne. -1 ) then
                  write(6,100) 'iokq', iokq(i), -1, i, x, x1, x2, x3
                  stop ' STOP -- QCHK Error: bad iokq(i) .ne. -1 '
               else if ( facq(i) .ne. 0.0 ) then
                  write(6,110) 'facq', facq(i), 0.0,
     $                 i, lin(i), x, x1, x2, x3
                  stop ' STOP -- QCHK Error: bad facq(i) .ne. 0.0 '
               endif
            endif
c
         endif
c-debug]
      endif
c
      if ( lin(i) .gt. 0 ) then
         qchk = ( y2 - y1 ) * facq(i) + ( y3 - y1 ) * omfq(i) + y1
      else if ( iokq(i) .gt. 0 ) then
         qchk = a21(i) * ( y2 - y1 ) + a32(i) * ( y3 - y2 ) + y2
      else
         yy(1) = y1
         yy(2) = y2
         yy(3) = y3
         if ( iokq(i) .lt. 0 ) then
            qchk = ( ( yy(i1q(i)) + yy(i2q(i)) ) * 0.5
     $           - yy(iloq(i)) ) * dxinvq(i) + yy(iloq(i))
         else
            qchk = ( ( ( yy(i1q(i)) + yy(i2q(i)) ) * 0.5
     $           - yy(iloq(i)) ) * dxinvq(i) + yy(iloq(i)) ) * omfq(i)
     $           + ( a21(i) * ( yy(2) - yy(1) )
     $           + a32(i) * ( yy(3) - yy(2) ) + yy(2) ) * facq(i)
         endif
      endif
c
      return
      end
c
c******************************************************************************
c
c-old;      function quad_old(ic,i,x,y1,y2,y3,x1,x2,x3)
c     ===========================================  ! OLD VERSION, INACCURATE;
c							! ALLOWS X-VARIATION
c..... this function performs a quadratic interpolation.	! FOR ic > 0
c
c  Storage for dx_i values that need not be computed on each call (see "ic");
c  NOTE that this same storage is used by all of QUAD, QDER, and QCHK.
c
c-old;      common /coquad_opal_z/ xx12(30),xx13(30),xx23(30),xx1pxx2(30)
c-old;      save /coquad_opal_z/
c___
c-old;      dimension xx(3),yy(3)
c===
c-old;      xx(1) = x1
c-old;      yy(1) = y1
c-old;      yy(2) = y2
c-old;      yy(3) = y3
c			    ! quad may be called many times with same x1,x2,x3;
c			    ! compute & store X-deltas only if flag ic says so:
c-old;      if ( ic .eq. 0 ) then
c-old;         xx(2) = x2
c-old;         xx(3) = x3
c-old;         xx12(i) = 1./(xx(1)-xx(2))
c-old;         xx13(i) = 1./(xx(1)-xx(3))
c-old;         xx23(i) = 1./(xx(2)-xx(3))
c-old;         xx1pxx2(i) = xx(1)+xx(2)
c-old;      endif
c
c-old;      c3 = ( (yy(1)-yy(2))*xx12(i) - (yy(2)-yy(3))*xx23(i) ) * xx13(i)
c-old;      c2 = (yy(1)-yy(2))*xx12(i) - xx1pxx2(i) * c3
c-old;      c1 = yy(1) - xx(1) * ( c2 + xx(1) * c3 )
c-old;      quad_old = c1+x*(c2+x*c3)
c-old;      return
c-old;      end
c
c******************************************************************************
c
c-old;      function qder_old(ic,i,x,y1,y2,y3,x1,x2,x3)
c     ===========================================  ! OLD VERSION, INACCURATE;
c						! ALLOWS X-VARIATION FOR ic > 0
c
c..... this function performs a quadratic interpolation; it is identical to the
c      function quad, except that it also computes the derivative dkap of the
c      quadratic at the given position x (see  common /d_opal_z/  below).
c
c  COMMON /d_opal_z/ : dkap returns the derivative (in interpolation-direction)
c
c-old;      common /d_opal_z/ dkap
c-old;      save /d_opal_z/
c
c  Storage for dx_i values that need not be computed on each call (see "ic");
c  NOTE that this same storage is used by all of QUAD, QDER, and QCHK.
c
c-old;      common /coquad_opal_z/ xx12(30),xx13(30),xx23(30),xx1pxx2(30)
c-old;      save /coquad_opal_z/
c___
c-old;      dimension xx(3),yy(3)
c===
c-old;      xx(1) = x1
c-old;      yy(1) = y1
c-old;      yy(2) = y2
c-old;      yy(3) = y3
c			    ! qder may be called many times with same x1,x2,x3;
c			    ! compute & store X-deltas only if flag ic says so:
c-old;      if ( ic .eq. 0 ) then
c-old;         xx(2) = x2
c-old;         xx(3) = x3
c-old;         xx12(i) = 1./(xx(1)-xx(2))
c-old;         xx13(i) = 1./(xx(1)-xx(3))
c-old;         xx23(i) = 1./(xx(2)-xx(3))
c-old;         xx1pxx2(i) = xx(1)+xx(2)
c-old;      endif
c
c-old;      c3 = ( (yy(1)-yy(2))*xx12(i) - (yy(2)-yy(3))*xx23(i) ) * xx13(i)
c-old;      c2 = (yy(1)-yy(2))*xx12(i) - xx1pxx2(i) * c3
c-old;      c1 = yy(1) - xx(1) * ( c2 + xx(1) * c3 )
c-old;      dkap = c2+(x+x)*c3
c-old;      qder_old = c1+x*(c2+x*c3)
c-old;      return
c-old;      end
c
c******************************************************************************
c
c-old;      function qchk_old(ic,i,x,y1,y2,y3,x1,x2,x3)
c     ===========================================
c
c  OLD version of qchk, which assumes that x may vary as well as y1, y2, y3
c
c-old;      parameter ( ratbeg=0.08, ratful=0.04, ratdel=1./(ratbeg-ratful) )
c
c  Storage for factors that need not be computed on each call (see "ic");
c  NOTE that QCHK calls QUAD: the QUAD/QDER storage is controlled by "ic" too.
c
c-old;      common/coqchk_opal_z/ facq(30),iokq(30),iloq(30),i1q(30),i2q(30),
c-old;     $     dxinvq(30),xloq(30),flin2(30),flin3(30),lin(30)
c-old;      save /coqchk_opal_z/
c___
c-old;      dimension xx(3),yy(3),r(3)
c===
c			    ! qchk may be called many times with same x1,x2,x3;
c			    ! compute & store X-deltas only if flag ic says so:
c-old;      if ( ic .eq. 0 ) then
c-old;         xx(1) = x1
c-old;         xx(2) = x2
c-old;         xx(3) = x3
c-old;         r(1) = abs(xx(3)-xx(2))
c-old;         r(2) = abs(xx(3)-xx(1))
c-old;         r(3) = abs(xx(2)-xx(1))
c-old;         if ( xx(3) - xx(1) .gt. 1.e-6 ) then
c-old;            lin(i) = 1
c-old;            omf = max( 0. , min( 1. ,
c-old;     $           ( xx(3) - xx(1) ) / max( xx(2) - xx(1) , 1.e-6 ) ) )
c-old;            flin3(i) = omf / ( xx(3) - xx(1) )
c-old;            flin2(i) = ( 1. - omf ) / max( xx(2) - xx(1) , 1.e-6 )
c-old;         else
c-old;            lin(i) = 0
c-old;         endif
c-old;         dxrat = min(r(1),r(2),r(3))/max(r(1),r(2),r(3))
c-old;         if ( dxrat .ge. ratbeg ) then
c-old;            iokq(i) = 1
c-old;         else
c-old;            if ( r(3) .lt. min(r(1),r(2)) ) then
c-old;               iloq(i) = 3
c-old;            else if ( r(2) .lt. r(1) ) then
c-old;               iloq(i) = 2
c-old;            else
c-old;               iloq(i) = 1
c-old;            endif
c-old;            i1q(i) = mod(iloq(i),3)+1
c-old;            i2q(i) = 6-i1q(i)-iloq(i)
c-old;            xloq(i) = xx(iloq(i))
c-old;            dxinvq(i) = 1./((xx(i1q(i))+xx(i2q(i)))*.5-xloq(i))
c-old;            if ( dxrat .gt. ratful ) then
c-old;               iokq(i) = 0
c-old;               facq(i) = (dxrat-ratful)*ratdel
c-old;            else
c-old;               iokq(i) = -1
c-old;               facq(i) = 0.
c-old;            endif
c-old;         endif
c-old;      endif
c
c-old;      if ( x .lt. x1 ) then
c-old;         if ( lin(i) .gt. 0 ) then
c-old;            qchk = ( ( y2 - y1 ) * flin2(i) + ( y3 - y1 ) * flin3(i) )
c-old;     $           * ( x - x1 ) + y1
c-old;            return
c-old;         endif
c-old;      endif
c
c-old;      if ( iokq(i) .gt. 0 ) then
c-old;         qchk = quad_old(ic,i,x,y1,y2,y3,x1,x2,x3)
c-old;      else
c-old;         yy(1) = y1
c-old;         yy(2) = y2
c-old;         yy(3) = y3
c-old;         if ( iokq(i) .lt. 0 ) then
c-old;            qchk = ((yy(i1q(i))+yy(i2q(i)))*.5-yy(iloq(i)))
c-old;     $           *(x-xloq(i))*dxinvq(i)+yy(iloq(i))
c-old;         else
c-old;            qchk = (((yy(i1q(i))+yy(i2q(i)))*.5-yy(iloq(i)))
c-old;     $           *(x-xloq(i))*dxinvq(i)+yy(iloq(i)))*(1.-facq(i))
c-old;     $           +facq(i)*quad_old(ic,i,x,y1,y2,y3,x1,x2,x3)
c-old;         endif
c-old;      endif
c
c-old;      return
c-old;      end
c
c******************************************************************************
c
      function qzinter(ic,i,z,nmorez,f1,f2,f3,f4,z1,z2,z3,z4,zdel)
c     ============================================================
c
c..... this function performs linear, quadratic, or bi-quadratic interpolation,
c      of logKappa in log(Z+zdel), for nmorez = 1, 2, or 3, respectively;
c      inputs are Z, nmorez = one less than the number of Z-values to
c      interpolate among, logKappa values f1 thru f4, Z-values z1 thru z4, and
c      zdel = 0.001 to make things work correctly near Z = 0.  Note that this
c      function is also sometimes used to interpolate in X or C or O.  It makes
c      use of the quadratic-interpolation function quad.
c
c  Storage for values that need not be computed on each call:
c
      common/qzint_opal_z/ v1(15), v2(15), v3(15), v4(15), v5(15)
      save /qzint_opal_z/
c===
      if ( ic .eq. 0 ) then
         if ( nmorez .gt. 0 ) then
c-debug[
            if ( zdel .lt. 0.000001 .or. zdel .gt. 0.1011 ) stop
     $           ' STOP -- QZINTER: bad Zdel value. '
c-debug]
            v5(i) = log10(z+zdel)
            v1(i) = log10(z1+zdel)
            v2(i) = log10(z2+zdel)
            if ( nmorez .eq. 1 ) then
               v3(i) = ( v2(i) - v5(i) ) / ( v2(i) - v1(i) )
               v4(i) = 1. - v3(i)
            else
               v3(i) = log10(z3+zdel)
               if ( nmorez .eq. 2 ) then
                  call quadsto( i, v5(i), v1(i), v2(i), v3(i) )
               else
                  v4(i) = log10(z4+zdel)
                  call quad4sto( i, v5(i), v1(i), v2(i), v3(i), v4(i) )
               endif
            endif
         endif
c-debug[
c-debug;      else if ( nmorez .gt. 0 ) then
c-debug;         if ( max( abs( v1(i) - log10(z1+zdel) ) ,
c-debug;     $        abs( v2(i) - log10(z2+zdel) ) ,
c-debug;     $        abs( v5(i) - log10(z+zdel) ) ) .gt. 1.e-5 ) stop
c-debug;     $        ' STOP -- QZINTER: Error: expected same X-values. '
c-debug;         if ( nmorez .eq. 1 ) then
c-debug;            if ( abs( v3(i) - (v2(i)-v5(i))/(v2(i)-v1(i)) ) .gt.
c-debug;     $           1.e-5 ) stop
c-debug;     $           ' STOP -- QZINTER: Error: expected same X-values. '
c-debug;         else
c-debug;            if ( abs( v3(i) - log10(z3+zdel) ) .gt. 1.e-5 ) stop
c-debug;     $           ' STOP -- QZINTER: Error: expected same X-values. '
c-debug;            if ( nmorez .ge. 3 ) then
c-debug;               if ( abs( v4(i) - log10(z4+zdel) ) .gt. 1.e-5 ) stop
c-debug;     $              ' STOP -- QZINTER: Error: expected same X-values. '
c-debug;            endif
c-debug;         endif
c-debug]
      endif
c
      if ( nmorez .le. 0 ) then
         qzinter = f1
      else if ( nmorez .eq. 1 ) then
         qzinter = max( min(f1,f2) , min( max(f1,f2) ,
     $        v3(i) * f1 + v4(i) * f2 ) )
      else if ( nmorez .eq. 2 ) then
         if ( v5(i) .lt. v2(i) ) then
            vlo = min(f1,f2)
            vhi = max(f1,f2)
         else
            vlo = min(f2,f3)
            vhi = max(f2,f3)
         endif
         qzinter = max( vlo , min( vhi , quadget(i,f1,f2,f3) ) )
      else
         qzinter = max( min(f2,f3) , min( max(f2,f3) ,
     $        quad4get(i,f1,f2,f3,f4) ) )
      endif
c
      return
      end
c
c******************************************************************************
c
      function mixfind(iu,iofe,igetzxi,irew,itab,l,zget,xget,cget,oget)
c     =================================================================
c
      parameter ( small_1m5=1.e-5 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( ks81=ntm-3, ks83=ks81+1, ks60=ks81-21, ks61=ks60+1,
     $     alrlo=-8.0, flogtlo=3.75, flogt60=6.0, flogt81=8.1 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c___
      character*255 cin
      character*1 ch(255)
      equivalence (ch(1),cin)
c-debug-chk[
c-debug-chk;      common /mixfind_opal_debug_chk/ iout_debug_chk(-10:10)
c-debug-chk;c---
c-debug-chk;      data iout_debug_chk / 21 * 99999 /
c-debug-chk]
c===
      ifound = 0
      cin = '                '
c					! if must rewind to beginning of file:
      if ( irew .ne. 0 ) then
c
         rewind(iu)
         l = 0
c					! else, if must get Xi/Z values:
      else if ( igetzxi .ne. 0 ) then
c
         do while( cin(1:31) .ne. ' Element   Abundance - relative' )
            l = l + 1
            read(iu,'(a255)',end=900) cin
         enddo
         sum_X = 0.
         sum_XoverA = 0.
         kel = 1
c					! begin loop to get Xi/Z values
         do while( kel .le. nel_zmix )
            l = l + 1
            read(iu,'(a255)',end=900) cin
            if ( cin(1:16) .eq. ' Table Summaries' ) goto 50
            ke = 255
            do while( ke .gt. 1 .and. ch(ke) .eq. ' ' )
               ke = ke-1
            enddo
            kb = 1
            do while( kb .le. ke .and. ch(kb) .eq. ' ' )
               kb = kb+1
            enddo
            if ( cin(kb:kb+1) .eq. cel_opalmixes(kel) ) then
c								! get Ni
               if ( ke .lt. kb+20 ) goto 50
               read(cin(ke-8:ke),'(f9.6)',err=50) vx
c							! last may be atomic wt
               if ( vx .gt. 1.000001 ) then
                  ke = ke-9
                  do while( ke .gt. 1 .and. ch(ke) .eq. ' ' )
                     ke = ke-1
                  enddo
                  if ( ke .lt. kb+20 ) goto 50
                  read(cin(ke-8:ke),'(f9.6)',err=50) vx
               endif
               sum_X = sum_X + vx
               sum_XoverA = sum_XoverA + vx / atwt_opalGS98(kel)
c								   ! get Xi
               ke = ke-9
               do while( ke .gt. 1 .and. ch(ke) .eq. ' ' )
                  ke = ke-1
               enddo
               if ( ke .lt. kb+11 ) goto 50
               read(cin(ke-7:ke),'(f8.6)',err=50) vn
c
               if ( iofe .le. 0 ) then
                  if ( igetzxi .gt. 0 ) then
c-debug-chk[
c-debug-chk;                     if ( iout_debug_chk(iofe) .gt. 0 ) then
c-debug-chk;                        if ( kel .eq. 1 ) write(6,3813) iofe,
c-debug-chk;     $                       cfile_opalGS98(-iofe)
c-debug-chk; 3813                   format(' '/' Mix in GS98hz and in file',i3,
c-debug-chk;     $                       ' = ',a40/
c-debug-chk;     $                       '  i  el      GS98:Ni   GS98:Xi',
c-debug-chk;     $                       ' stored:Ni stored:Xi  read:Ni ',
c-debug-chk;     $                       '  read:Xi sto[i/Fe]'/
c-debug-chk;     $                       ' --  --    --------- ---------',
c-debug-chk;     $                       ' --------- --------- ---------',
c-debug-chk;     $                       ' --------- --------')
c-debug-chk;                        write(6,3814) kel, cel_opalmixes(kel),
c-debug-chk;     $                       fninz_opalGS98(kel,1),
c-debug-chk;     $                       xiz_opalGS98(kel,1),
c-debug-chk;     $                       fninz_opalGS98(kel,-iofe),
c-debug-chk;     $                       xiz_opalGS98(kel,-iofe), vn, vx,
c-debug-chk;     $                       log10( (
c-debug-chk;     $                       max(fninz_opalGS98(kel,-iofe),1.e-36)
c-debug-chk;     $                       * fninz_opalGS98(kel_fe,1) )
c-debug-chk;     $                       / ( max(fninz_opalGS98(kel_fe,-iofe),
c-debug-chk;     $                       1.e-36) * fninz_opalGS98(kel,1) ) )
c-debug-chk; 3814                   format(i3,': ',a2,' --',6f10.7,f9.5)
c-debug-chk;                     endif
c-debug-chk]
                     xiz_opalGS98(kel,-iofe) = vx
                     fninz_opalGS98(kel,-iofe) = vn
                  else if ( max( abs( fninz_opalGS98(kel,-iofe) - vn )
     $                    , abs( xiz_opalGS98(kel,-iofe) - vx ) )
     $                    .gt. 0.000015 ) then
                     if ( iofe .lt. -1 .and.
     $                    cfile_opalGS98(-iofe) .eq. ' ' ) then
                        io_t = 4
                     else
                        io_t = -iofe
                     endif
                     write(6,35) cel_opalmixes(kel),
     $                    cfile_opalGS98(io_t)(1:
     $                    lnblnk(cfile_opalGS98(io_t))),
     $                    vx,xiz_opalGS98(kel,-iofe),
     $                    vn,fninz_opalGS98(kel,-iofe)
 35                  format(' '/' READCO: Warning: stored value',
     $                    ' differs from new Xi/Z for ',a2,
     $                    ' in alt-file:'/' ',a/
     $                    '          new Xi/Z',f9.6,' vs.',f9.6,
     $                    ' ,  new Ni/Nz',f9.6,' vs.',f9.6/' ')
                  endif
               else if ( igetzxi .gt. 0 ) then
                  xiz_opalmixes(kel,iofe) = vx
                  fninz_opalmixes(kel,iofe) = vn
c-debug-chk[
c-debug-chk;                  if ( iout_debug_chk(iofe) .gt. 0 ) then
c-debug-chk;                     if ( kel .eq. 1 ) write(6,3813) iofe,
c-debug-chk;     $                    cfile_opalmixes(iofe)
c-debug-chk;                     write(6,3814) kel, cel_opalmixes(kel),
c-debug-chk;     $                    fninz_opalmixes(kel,1),
c-debug-chk;     $                    xiz_opalmixes(kel,1),
c-debug-chk;     $                    fninz_opalmixes(kel,iofe),
c-debug-chk;     $                    xiz_opalmixes(kel,iofe), vn, vx,
c-debug-chk;     $                    log10(
c-debug-chk;     $                    ( max(fninz_opalmixes(kel,iofe),1.e-36)
c-debug-chk;     $                    * fninz_opalmixes(kel_fe,1) )
c-debug-chk;     $                    / ( max(fninz_opalmixes(kel_fe,iofe),
c-debug-chk;     $                    1.e-36) * fninz_opalmixes(kel,1) ) )
c-debug-chk;                  endif
c-debug-chk]
               else if ( max( abs( fninz_opalmixes(kel,iofe) - vn ) ,
     $                 abs( xiz_opalmixes(kel,iofe) - vx ) )
     $                 .gt. 0.000015 ) then
                  write(6,40) cel_opalmixes(kel),cfile_opalmixes(iofe),
     $                 vx,xiz_opalmixes(kel,iofe),
     $                 vn,fninz_opalmixes(kel,iofe)
 40               format(' '/' READCO: Warning: new Xi/Z for ',a2,
     $                 ' in ',a8,' mix differs from stored value:'/
     $                 '          new Xi/Z',f9.6,' vs.',f9.6,
     $                 ' ,  new Ni/Nz',f9.6,' vs.',f9.6/' ')
c
c-dont;                  goto 60
               endif
               kel = kel+1
            endif
c					! end of loop to get Xi/Z values
         enddo
c					! check Xi vs Ni; get xO/xFe and [O/Fe]
         if ( igetzxi .gt. 0 ) then
            kel_err = 0
            if ( iofe .le. 0 ) then
               do kel = 1, nel_zmix
                  if ( abs( xiz_opalGS98(kel,-iofe)
     $                 / ( atwt_opalGS98(kel) * sum_XoverA )
     $                 - fninz_opalGS98(kel,-iofe) ) .gt. 0.00001 ) then
                     kel_err = kel_err + 1
                     write(6,4613) kel, cel_opalmixes(kel), iofe,
     $                    fninz_opalGS98(kel,-iofe),
     $                    xiz_opalGS98(kel,-iofe)
     $                    / ( atwt_opalGS98(kel) * sum_XoverA )
 4613                format(' READCO: Error in element',i3,
     $                    ' = "',a2,'" when reading in mix',i3,':'/
     $                    '   number fraction',f10.6,' does not match',
     $                    f10.6,' = (Xi/Ai) / [Sum{Xi/Ai}]')
                  endif
                  xiz_opalGS98(kel,-iofe) =
     $                 xiz_opalGS98(kel,-iofe) / sum_X
                  fninz_opalGS98(kel,-iofe) = xiz_opalGS98(kel,-iofe)
     $                 / ( atwt_opalGS98(kel) * sum_XoverA )
               enddo
c-debug-chk[
c-debug-chk;               if ( iout_debug_chk(iofe) .gt. 0 ) then
c-debug-chk;                  write(6,3815) xofe_opalGS98(1),
c-debug-chk;     $                 bracketofe_opalGS98(1),
c-debug-chk;     $                 xofe_opalGS98(-iofe),
c-debug-chk;     $                 bracketofe_opalGS98(-iofe),
c-debug-chk;     $                 fninz_opalGS98(kel_o,-iofe)
c-debug-chk;     $                 / max(fninz_opalGS98(kel_fe,-iofe),1.e-36),
c-debug-chk;     $                 log10( ( fninz_opalGS98(kel_o,-iofe)
c-debug-chk;     $                 / max(fninz_opalGS98(kel_fe,-iofe),1.e-36) )
c-debug-chk;     $                 / xofe_opalGS98(1) )
c-debug-chk; 3815             format('O/Fe,[O/Fe]',6f10.6/' ')
c-debug-chk;                  iout_debug_chk(iofe) = iout_debug_chk(iofe) - 1
c-debug-chk;               endif
c-debug-chk]
               xofe_opalGS98(-iofe) = fninz_opalGS98(kel_o,-iofe)
     $              / max( fninz_opalGS98(kel_fe,-iofe) , 1.e-36 )
               if ( iofe .ne. 0 )
     $              bracketofe_opalGS98(-iofe) = log10( max( 1.e-36 ,
     $              xofe_opalGS98(-iofe) / xofe_opalGS98(1) ) )
            else
               do kel = 1, nel_zmix
                  if ( abs( xiz_opalmixes(kel,iofe)
     $                 / ( atwt_opalGS98(kel) * sum_XoverA )
     $                 - fninz_opalmixes(kel,iofe) ) .gt. 0.00001 ) then
                     kel_err = kel_err + 1
                     write(6,4613) kel, cel_opalmixes(kel), iofe,
     $                    fninz_opalmixes(kel,iofe),
     $                    xiz_opalmixes(kel,iofe)
     $                    / ( atwt_opalGS98(kel) * sum_XoverA )
                  endif
                  xiz_opalmixes(kel,iofe) =
     $                 xiz_opalmixes(kel,iofe) / sum_X
                  fninz_opalmixes(kel,iofe) = xiz_opalmixes(kel,iofe)
     $                 / ( atwt_opalGS98(kel) * sum_XoverA )
               enddo
c-debug-chk[
c-debug-chk;               if ( iout_debug_chk(iofe) .gt. 0 ) then
c-debug-chk;                  write(6,3815) xofe_opalmixes(1),
c-debug-chk;     $                 bracketofe_opalmixes(1),
c-debug-chk;     $                 xofe_opalmixes(iofe),
c-debug-chk;     $                 bracketofe_opalmixes(iofe),
c-debug-chk;     $                 fninz_opalmixes(kel_o,iofe)
c-debug-chk;     $                 / max(fninz_opalmixes(kel_fe,iofe),1.e-36),
c-debug-chk;     $                 log10( ( fninz_opalmixes(kel_o,iofe)
c-debug-chk;     $                 / max(fninz_opalmixes(kel_fe,iofe),1.e-36) )
c-debug-chk;     $                 / xofe_opalmixes(1) )
c-debug-chk;                  iout_debug_chk(iofe) = iout_debug_chk(iofe) - 1
c-debug-chk;               endif
c-debug-chk]
               xofe_opalmixes(iofe) = fninz_opalmixes(kel_o,iofe)
     $              / max( fninz_opalmixes(kel_fe,iofe) , 1.e-36 )
               bracketofe_opalmixes(iofe) = log10( max( 1.e-36 ,
     $              xofe_opalmixes(iofe) / xofe_opalmixes(1) ) )
            endif
            if ( kel_err .ne. 0 ) stop
     $           ' STOP -- READCO: Incompatible Ni vs. Xi read in. '
         endif
c					! no read error: jump to continuation
         goto 60
c				! if error reading Xi/Z values, say so
 50      write(6,20) iofe, kel
 20      format(' '/' READCO: Warning: error reading mix',i3,
     $        ': Z-abundance fractions at element',i3/' ')
         if ( igetzxi .ge. 9 ) stop
     $        ' STOP -- READCO: Cannot get mix from user [O/Fe]-file. '
c
c								! continuation
 60      continue
c				   ! if reading meteoritic mix, we are done
         if ( iofe .eq. 0 ) then
            mixfind = 1
            return
         endif
c				   ! end of reading Xi/Z values in file header
      endif
c							! find start of tables
      if ( irew .ne. 0 .or. igetzxi .ne. 0 ) then
         do while( cin(1:30) .ne. '******************************' )
            l = l + 1
            read(iu,'(a255)',end=900) cin
         enddo
         igetzxi = 0
      endif
c				  ! look for mix with required composition:
      do while ( ifound .eq. 0 )
         l = l + 1
         read(iu,'(a255)',end=900) cin
         if ( cin(1:7) .eq. 'TABLE #' ) then
            ke = 90
            do while( ke .gt. 1 .and. ch(ke) .eq. ' ' )
               ke = ke-1
            enddo
            if ( ke .lt. 60 ) goto 900
            read(cin(ke-48:ke),100) xat,yat,zat,cat,oat
 100        format(3(3x,f6.4),2(5x,f6.4))
            if ( max( abs(zat-zget) , abs(xat-xget) , abs(cat-cget),
     $           abs(oat-oget) ) .lt. 0.000001 ) ifound = -1
         endif
      enddo
c				  ! found required mix: read its table number
      read(cin(8:10),105) itabat
 105  format(i3)
c		 ! if it does not consecutively follow previous table, may need
c		 !  to rewind back to beginning of file for next composition
      irew = 0
      if ( itabat .ne. itab+1 ) irew = 1
      itab = itabat
c					! check log R values in table head
      do i = 1,3
         l = l + 1
         read(iu,'(a255)',end=900) cin
      enddo
      l = l + 1
      read(iu,110,err=900,end=900) cin(1:4),(alrf(i),i=1,nrm)
 110  format(a4,f6.1,18f7.1)
c					! this may or may not be useful/correct
      if ( cin(1:4) .ne. 'logT' .or.
     $     abs(alrf(1)-alrlo) .gt. small_1m5 ) goto 900
c
      do k = 2,nrm
         if ( abs(alrf(k)-alrf(k-1)-0.5) .gt. small_1m5 ) stop
     $        ' STOP -- READCO: bad  log R  value in table read in. '
      enddo
c				     ! read blank line before first table line
      l = l + 1
      read(iu,'(a255)',end=900) cin
c				     ! table header lines appear correct:
      ifound = iabs( ifound )
c					! return
 900  mixfind = ifound
c-debug-chk[
c-debug-chk;      if ( ifound .eq. 0 )
c-debug-chk;     $     write(6,1739) iu,itab,irew,zget,xget,cget,oget
c-debug-chk; 1739 format(' '/' MIXFIND: unit',i3,' after TABLE',i3,
c-debug-chk;     $     ', irew=',i2,': could not find mix Z=',f10.7,
c-debug-chk;     $     ' X=',f10.7,' C=',f10.7,' O=',f10.7)
c-debug-chk]
      if ( ifound .eq. 0 ) irew = 1
      return
      end
c
c******************************************************************************
c
      subroutine chk_dir_name( cdirin, copdir, kope )
c     ===============================================
c
      character*(*) cdirin
      character*255 copdir
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c---
c-dir;      logical lxst
c===
      last = lnblnk( cdirin )
      ibeg = max( 1 , non_blank_begin(cdirin) )
c
      kope = last - ibeg + 1
c
      if ( kope .eq. 0  ) then
c
         copdir = ' '
c
      else
c
         if ( level_err .gt. 0 ) then
            iblank = num_blanks_contained( cdirin )
            if ( iblank .gt. 0 ) then
               write(6,10) iblank, cdirin(ibeg:last)
 10            format(' WARNING:',i5,' blanks contained in',
     $              ' directory name:'/' ',a)
               if ( level_err .ge. 2 ) then
                  kope = -9
                  return
               endif
            endif
         endif
c
         if ( cdirin(last:last) .ne. cb(1) .and.
     $        cdirin(last:last) .ne. cb(2) ) kope = kope + 1
c
         if ( kope .gt. 246 ) then
            write(6,20) kope, cdirin(ibeg:last)
 20         format(' Error: length',i5,
     $           ' exceeds 246 for directory name:'/' ',a)
            kope = -9
            return
         endif
c
         copdir = cdirin(ibeg:)
c
         if ( kope .gt. last - ibeg + 1 ) then
            if ( cb(2) .ne. ']' ) then
               copdir(kope:kope) = cb(1)
            else
               i = kope - 1
               do while ( i .gt. 0 .and.
     $              copdir(max(1,i):max(1,i)) .ne. '[' )
                  if ( copdir(i:i) .eq. cb(1) ) then
                     write(6,30) copdir(:kope-1)
 30                  format(' Error: the character immediately foll',
     $                    'owing ":" must be "[" in directory name:'/
     $                    ' 'a)
                     kope = -9
                     return
                  else if ( copdir(i:i) .eq. cb(2) ) then
                     write(6,40) copdir(:kope-1)
 40                  format(' Error: the character "]" must not occur',
     $                    ' before the end of the directory name:'/
     $                    ' 'a)
                     kope = -9
                     return
                  endif
                  i = i - 1
               enddo
               if ( i .gt. 0 ) then
                  copdir(kope:kope) = cb(2)
               else
                  copdir(kope:kope) = cb(1)
               endif
            endif
         endif
c
c  NOTE that some systems return FALSE for the existence of a directory, so
c  one cannot check for the directory's existence.
c
c-dir;         call inqfil( copdir, lxst )
c-dir;         if ( .not. lxst ) then
c-dir;            write(6,90) copdir(:kope)
c-dir; 90         format(' Error: directory does not exist:'/' ',a)
c-dir;            kope = -9
c-dir;            return
c-dir;         endif
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine chk_ofe_alt_file( k_ofe )
c     ====================================
c
c  For non-GN93 mixes, the "[O/Fe] > 0" filename may or may not end in 'hz'
c  so check this (by checking which version of the file exists on disk)
c  and set  cfile_opal_used(n_zmixes)  accordingly.
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      character*255 cfile_opal_used(-1:n_totmix)
      common /c_mixfiles_used_opal_z/ cfile_opal_used
      save /c_mixfiles_used_opal_z/
c
      character*255 copdir
      common/opdir/ copdir
      save /opdir/
c
      common/recoin_opal_z/ itimeco,mxzero,mx03,kope,igznotgx
      save /recoin_opal_z/
c
      character*511 ctmp
c
      if ( cfile_opalGS98(k_ofe) .eq. ' ' ) then
         cfile_opal_used(n_zmixes) = cfile_opalGS98(4)
      else
         cfile_opal_used(n_zmixes) = cfile_opalGS98(k_ofe)
      endif
c
      ctmp = copdir
      ctmp(kope+1:) = cfile_opal_used(n_zmixes)
c
      call open_chk_zip( -99999, ctmp, igzip, '???' )
c
      if ( igzip .eq. -99999 ) then
c
         last = lnblnk( cfile_opal_used(n_zmixes) )
         iadd = 0
c
         if ( last .ge. 2 ) then
            if ( cfile_opal_used(n_zmixes)(last-1:last) .eq.
     $           'hz' ) then
               if ( last .gt. 2 ) iadd = -1
            else if ( last .le. 253 ) then
               iadd = 1
            endif
         else
            iadd = 1
         endif
c
         if ( iadd .lt. 0 ) then
            ctmp(kope+last-1:) = '  '
            call open_chk_zip( -99999, ctmp, igzip, '???' )
         else if ( iadd .gt. 0 ) then
            ctmp(kope+last+1:) = 'hz'
            call open_chk_zip( -99999, ctmp, igzip, '???' )
         endif
c
         if ( igzip .ne. -99999 ) then
            if ( iadd .lt. 0 ) then
               cfile_opal_used(n_zmixes)(last-1:) = '  '
            else if ( iadd .gt. 0 ) then
               cfile_opal_used(n_zmixes)(last+1:) = 'hz'
            endif
         endif
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine index_co_deltas( iset, kxhz, jx, jc, jo )
c     ====================================================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mx_hi=2*mx, mx_m1=mx-1, mo_m1=mo-1, mo_m2=mo-2,
     $     mo_m10=mo-mx_hi, mo_p1=mo+1, mc_m1=mc-1, mc_m2=mc-2,
     $     mc_p7=mc+mx+2 )
c
      if ( iset .le. 0 .or. iset .gt. 5 .or. kxhz .le. 0 .or.
     $     kxhz .gt. mx_hi .or. mx .ne. 5 ) stop
     $     ' INDEX_DELTAS: Error: bad inputs: cannot happen. '
c
      if ( iset .eq. 2 ) then
         if ( kxhz .le. 5 ) then
            jx = kxhz
            jc = mc
            jo = mo_m2
         else
            jx = kxhz - 5
            jc = mc_m1
            jo = mo_m1
         endif
      else if ( iset .eq. 3 ) then
         jx = mx
         if ( kxhz .le. 5 ) then
            jc = mc
            jo = kxhz
         else
            jc = mc_m1
            jo = kxhz - 5
         endif
      else if ( iset .eq. 4 ) then
         jx = mx
         if ( kxhz .le. 5 ) then
            jc = kxhz
            jo = mo_m1
         else
            jc = kxhz - 5
            jo = mo_m2
         endif
      else if ( iset .eq. 5 ) then
         if ( kxhz .le. 5 ) then
            jx = mx
            jc = mc_m2
            jo = mo_p1 - kxhz
         else
            jx = mx_m1
            jc = min( mc_p7 - kxhz , mc )
            jo = min( mo_m10 + kxhz , mo_m1 )
         endif
      else
         jc = mc
         if ( kxhz .le. 5 ) then
            jx = kxhz
            jo = mo
         else
            jx = kxhz - 5
            jo = mo_m1
         endif
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine finish_cno
c     =====================
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      parameter ( mx_hi=2*mx, mo_m1=mo-1, mo_m2=mo-2 )
c
      common/a_opal_z/ indx(101),t6list(nt),alr(nr),n(mx,mo,nz),
     $     alt(nt),dfs(nt),dfsr(nr),b(3),m,mf,xa(8),alrf(nrm),
     $     flogtin(ntm),dfsx(mx),oxf(mx,mc,nz),cxf(mx,mo,nz),
     $     xcdf(mx,mo,nz),xodf(mx,mc,nz),itime,cxdf(mx,mo,nz),
     $     oxdf(mx,mc,nz),q(4),h(4),xcd(mc),xod(mc),xc(mc),xo(mo),
     $     xcs(mc),xos(mo),cxd(mc),oxd(mo),cx(mc),ox(mo),zzz(nz),xxh,
     $     xx(mx),nc,no,zsto(nz),zvint(nz),dfsz(nz),zacc(nz),
     $     zlow,zmiddle,zhigh,zlo_ex,zhi_ex,numz
      save /a_opal_z/
c
      common /a_co_opal_z/ co(mx,mc,mo,nt,nr,nz),
     $     opk(mx,4),opl(nt,nr,nz),cof(nt,nr)
      save /a_co_opal_z/
c
      common /xhi_opal_z/ xhi_in(mx_hi), xcno_use(mx_hi,nz),
     $     xhi_use(mx_hi,nz), xxx_cno(mx_hi), xxx_hi(mx_hi),
     $     nx_hi(nz), ireq_hi(mx_hi), khighx(nz), kavail_xhi, kuse_xhi,
     $     kdo_xhi, kavail_cno, kuse_cno, kdo_cno, kavail_user,
     $     kuse_user, kdo_user
      save /xhi_opal_z/
c
      parameter ( nel_zmix=19, n_zmixes=5, kel_o=3, kel_fe=nel_zmix-1 )
c
      character*2 cel_opalmixes(nel_zmix)
      character*8 cfile_opalmixes(n_zmixes)
      common/opalmixes/ xiz_mix(nel_zmix),fninz_mix(nel_zmix),
     $     bracketife_mix(nel_zmix),bracketofe_opalmixes(n_zmixes),
     $     xofe_opalmixes(n_zmixes),xiz_opalmixes(nel_zmix,n_zmixes),
     $     fninz_opalmixes(nel_zmix,n_zmixes),
     $     cel_opalmixes,cfile_opalmixes
      save /opalmixes/
c
      parameter ( n_totmix = n_zmixes + 5, n_cnobeg = n_zmixes + 1 )
c
      character*255 cfile_opalGS98(0:n_totmix)
      common /opalGS98mixes/ bracketofe_opalGS98(0:n_totmix),
     $     xofe_opalGS98(0:n_totmix),xiz_opalGS98(nel_zmix,0:n_totmix),
     $     fninz_opalGS98(nel_zmix,0:n_totmix),atwt_opalGS98(nel_zmix),
     $     cfile_opalGS98
      save /opalGS98mixes/
c
      common /cno_delta_opal_z/ fcno_mul(4), fninz_cno(nel_zmix,5),
     $     xiz_cno(nel_zmix,5), d_fninz_user(nel_zmix),
     $     fcno_fac(0:3,4), fninz_heavy, xiz_heavy, d_fninz_u_heavy,
     $     s_ninzai_mix, ds_ninzai_u, fn_o_over_cno, fninz_co_mix
      save /cno_delta_opal_z/
c
      common /c_level_err_opal_z/ level_err
      save /c_level_err_opal_z/
c___
      parameter ( ncno2 = n_cnobeg + 1, ncno3 = ncno2 + 1,
     $     ncno4 = ncno3 + 1 )
c
      dimension cno_del_chk(2:4,4)
c===
c
c  If user-specified opacity shifts were read in and the error-check level = 2,
c  then check the composition difference relative to the standard opacity file:
c
      if ( kavail_user .gt. 0 ) then
c
         del_max = 0.0
         do i = 1, nel_zmix
            fninz_cno(i,5) = fninz_opalGS98(i,n_totmix)
            xiz_cno(i,5) = xiz_opalGS98(i,n_totmix)
            d_fninz_user(i) = fninz_opalGS98(i,n_totmix)
     $           - fninz_opalGS98(i,n_cnobeg)
            del_max = max( del_max , abs( d_fninz_user(i) ) )
         enddo
c
         if ( del_max .lt. 0.000015 .and. level_err .gt. 0 ) then
            write(6,10)
 10         format(' '/' WARNING: user-specified OPAL opacity',
     $           ' interpolation file has a'/
     $           '          composition identical to that',
     $           ' of the standard opacity file.'/' ')
         else if ( del_max .lt. 0.001 .and. level_err .ge. 2 ) then
            write(6,20) del_max
 20         format(' '/' WARNING: user-specified OPAL opacity',
     $           ' interpolation file has a composition'/
     $           '          similar to that of the standard',
     $           ' opacity file: max delta =',1p,e9.2/' ')
         endif
c
      endif
c
c  If CNO-interpolation opacity shifts were read in, check them and compute
c  some useful multiplicative factors:
c
      if ( kavail_cno .gt. 0 ) then
c				     ! check for similar C,N,O,Ne compositions:
         del_12 = 0.0
         del_13 = 0.0
         del_14 = 0.0
         del_23 = 0.0
         del_34 = 0.0
         del_24 = 0.0
c
         do i = 1, 4
c							! for linear-dep check
            cno_del_chk(2,i) = fninz_opalGS98(i,ncno2)
     $           - fninz_opalGS98(i,n_cnobeg)
            cno_del_chk(3,i) = fninz_opalGS98(i,ncno3)
     $           - fninz_opalGS98(i,n_cnobeg)
            cno_del_chk(4,i) = fninz_opalGS98(i,ncno4)
     $           - fninz_opalGS98(i,n_cnobeg)
c
c				! check for very similar pairs of compositions
c
            del_12 = max( del_12 , abs( cno_del_chk(2,i) ) )
            del_13 = max( del_13 , abs( cno_del_chk(3,i) ) )
            del_14 = max( del_14 , abs( cno_del_chk(4,i) ) )
            del_23 = max( del_23 , abs( fninz_opalGS98(i,ncno3)
     $           - fninz_opalGS98(i,ncno2) ) )
            del_34 = max( del_34 , abs( fninz_opalGS98(i,ncno4)
     $           - fninz_opalGS98(i,ncno3) ) )
            del_24 = max( del_24 , abs( fninz_opalGS98(i,ncno2)
     $           - fninz_opalGS98(i,ncno4) ) )
c						! are all of C,N,O,Ne varied?
            if ( max( abs( cno_del_chk(2,i) ) ,
     $           abs( cno_del_chk(3,i) ) ,
     $           abs( cno_del_chk(4,i) ) ) .lt. 0.05 ) kavail_cno = 0
c
         enddo
c
         if ( min( del_12 , del_13 , del_14 ,
     $        del_23 , del_34 , del_24 ) .lt. 0.05 ) kavail_cno = 0
c
c				! check for linear dependence among CNO-mixes
         lindep = 0
c
         if ( kavail_cno .gt. 0 ) then
c
            do k = 3, 4
               i = 1
               do while ( i .lt. kel_o .and.
     $              abs( cno_del_chk(2,i) ) .lt. 0.009 )
                  i = i + 1
               enddo
               f = cno_del_chk(k,i) / cno_del_chk(2,i)
               if ( max(
     $              abs( f * cno_del_chk(2,1) - cno_del_chk(k,1) ) ,
     $              abs( f * cno_del_chk(2,2) - cno_del_chk(k,2) ) ,
     $              abs( f * cno_del_chk(2,kel_o)
     $              - cno_del_chk(k,kel_o) ) ) .lt. 0.005 ) lindep = 1
            enddo
c
            if ( lindep .eq. 0 ) then
c
               g = cno_del_chk(2,1) * cno_del_chk(3,2)
     $              - cno_del_chk(3,1) * cno_del_chk(2,2)
               if ( abs( g ) .lt. 2.5d-5 ) then
                  lindep = 1
               else
                  f = ( cno_del_chk(3,2) * cno_del_chk(4,1)
     $                 - cno_del_chk(4,2) * cno_del_chk(3,1) ) / g
                  g = ( cno_del_chk(2,1) * cno_del_chk(4,2)
     $                 - cno_del_chk(4,1) * cno_del_chk(2,2) ) / g
                  if ( abs( f * cno_del_chk(2,3) + g * cno_del_chk(3,3)
     $                 - cno_del_chk(4,3) ) .lt. 0.005 ) lindep = 1
               endif
c
            endif
c
         endif
c								    ! Bad CNO?
         if ( kavail_cno .eq. 0 ) then
c
            if ( level_err .gt. 0 ) write(6,30)
 30         format(' WARNING: CNO-interpolation in OPAL',
     $           ' opacities is NOT POSSIBLE: the C,N,O,Ne'/
     $           ' abundances are too similar in the',
     $           ' specified CNO-interpolation opacity files.')
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- READCO Error: bad CNO-interpolation files. '
c
c							     ! or low main CNO?
         else if ( fninz_opalGS98(1,n_cnobeg) .lt. 0.05 .or.
     $           fninz_opalGS98(2,n_cnobeg) .lt. 0.01 .or.
     $           fninz_opalGS98(kel_o,n_cnobeg) .lt. 0.2 ) then
c
            kavail_cno = 0
            if ( level_err .gt. 0 ) write(6,40)
 40         format(' WARNING: CNO-interpolation in OPAL',
     $           ' opacities is NOT POSSIBLE: the "standard"'/
     $           ' CNO-opacity-file has low abundance(s) of C,N,O =',
     $           1p,3e9.2)
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- READCO Error: bad "standard"-CNO-file. '
c
c							      ! enhanced C,O or
c								 ! depleted Ne?
         else if ( fninz_opalGS98(1,n_cnobeg) .lt. 0.999 * max(
     $           fninz_opalGS98(1,ncno2) , fninz_opalGS98(1,ncno3) ,
     $           fninz_opalGS98(1,ncno4) ) .or.
     $           fninz_opalGS98(kel_o,n_cnobeg) .lt. 0.999 * max(
     $           fninz_opalGS98(kel_o,ncno2) ,
     $           fninz_opalGS98(kel_o,ncno3) ,
     $           fninz_opalGS98(kel_o,ncno4) ) .or.
     $           fninz_opalGS98(4,n_cnobeg) .gt. 1.001 * min(
     $           fninz_opalGS98(4,ncno2) , fninz_opalGS98(4,ncno3) ,
     $           fninz_opalGS98(4,ncno4) ) ) then
c
            kavail_cno = 0
            if ( level_err .gt. 0 ) write(6,50)
 50         format(' WARNING: CNO-interpolation in OPAL',
     $           ' opacities is NOT POSSIBLE: these CNO-'/
     $           ' interpolation files should NOT have',
     $           ' C or O enhancements or Ne depletions.')
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- READCO Error: bad CNO-interpolation files. '
c
         else if ( lindep .gt. 0 ) then
c
            kavail_cno = 0
            if ( level_err .gt. 0 ) write(6,60)
 60         format(' WARNING: CNO-interpolation in OPAL',
     $           ' opacities is NOT POSSIBLE: compositions of'/
     $           '            the CNO-interpolation files',
     $           ' are linearly dependent in {C,N,O}-space.')
            if ( level_err .ge. 2 ) stop
     $           ' STOP -- READCO Error: bad CNO-interpolation files. '
c
         else
c			   ! Else: O.K. so far; check elements heavier than Ne:
            del_12 = 0.0
            del_13 = 0.0
            del_14 = 0.0
            del_23 = 0.0
            del_34 = 0.0
            del_24 = 0.0
            del_max = 0.0
c
            do i = 5, nel_zmix
c								! sums of diffs
               del_12 = del_12 + fninz_opalGS98(i,n_cnobeg)
     $              - fninz_opalGS98(i,ncno2)
               del_13 = del_13 + fninz_opalGS98(i,n_cnobeg)
     $              - fninz_opalGS98(i,ncno3)
               del_14 = del_14 + fninz_opalGS98(i,n_cnobeg)
     $              - fninz_opalGS98(i,ncno4)
               del_23 = del_23 + fninz_opalGS98(i,ncno3)
     $              - fninz_opalGS98(i,ncno2)
               del_34 = del_34 + fninz_opalGS98(i,ncno4)
     $              - fninz_opalGS98(i,ncno3)
               del_24 = del_24 + fninz_opalGS98(i,ncno2)
     $              - fninz_opalGS98(i,ncno4)
c								! max diff
               del_max = max( abs( fninz_opalGS98(i,n_cnobeg)
     $              - fninz_opalGS98(i,ncno2) ) ,
     $              abs( fninz_opalGS98(i,n_cnobeg)
     $              - fninz_opalGS98(i,ncno3) ) ,
     $              abs( fninz_opalGS98(i,n_cnobeg)
     $              - fninz_opalGS98(i,ncno4) ) , del_max )
c
            enddo
c
            del_sum = max( abs(del_12) , abs(del_13) , abs(del_14) ,
     $           abs(del_23) , abs(del_34) , abs(del_24) )
c								 ! Bad heavies?
            if ( del_sum .gt. 0.001 .or. del_max .gt. 0.05 ) then
c
               kavail_cno = 0
               if ( level_err .gt. 0 ) write(6,70) del_sum, del_max
 70            format(' WARNING: CNO-interpolation in OPAL',
     $              ' opacities is NOT POSSIBLE: C+N+O+Ne sums'/
     $              ' differ by',1p,e9.2,
     $              ' > 0.001, OR max heavy-element-delta of',e9.2,
     $              ' > 0.05')
               if ( level_err .ge. 2 ) stop
     $              ' STOP -- READCO Error: bad CNO-interp-files. '
c								   ! Else: O.K.
            else
c			  ! composition of main-CNO file same as OPAL mix used?
               if ( max(
     $              abs( fninz_opalGS98(1,n_cnobeg) - fninz_mix(1) ) ,
     $              abs( fninz_opalGS98(2,n_cnobeg) - fninz_mix(2) ) ,
     $              abs( fninz_opalGS98(kel_o,n_cnobeg)
     $              - fninz_mix(kel_o) ) ,
     $              abs( fninz_opalGS98(4,n_cnobeg) - fninz_mix(4) ) )
     $              .lt. 0.001 ) then
c					! no CNO-modifications necessary
                  do k = 1, 4
c
                     fcno_mul(k) = 1.0
c
                     j = k + n_zmixes
c
                     do i = 1, nel_zmix
                        fninz_cno(i,k) = fninz_opalGS98(i,j)
                        xiz_cno(i,k) = xiz_opalGS98(i,j)
                     enddo
c
                  enddo
c			  ! Else: if composition differs from OPAL mix used:
               else
c					! get modified CNO-mixes
                  do i = 1, nel_zmix
                     fninz_cno(i,1) = fninz_mix(i)
                     fninz_cno(i,2) = fninz_mix(i)
                     fninz_cno(i,3) = fninz_mix(i)
                     fninz_cno(i,4) = fninz_mix(i)
                  enddo
c					! and CNO-modification factors
                  do k = 2, 4
c
                     j = k + n_zmixes
c
                     f_c = min( 1.0 , fninz_opalGS98(1,j)
     $                    / fninz_opalGS98(1,n_cnobeg) )
                     f_n = min( 1.0 , fninz_opalGS98(2,j)
     $                    / fninz_opalGS98(2,n_cnobeg) )
                     f_o = min( 1.0 , fninz_opalGS98(kel_o,j)
     $                    / fninz_opalGS98(kel_o,n_cnobeg) )
c
                     fninz_cno(1,k) = f_c * fninz_mix(1)
                     fninz_cno(kel_o,k) = f_o * fninz_mix(kel_o)
c
                     if ( f_n .lt. 1.0 ) then
c
                        fninz_cno(2,k) = f_n * fninz_mix(2)
                        fninz_cno(4,k) = fninz_mix(4)
     $                       + ( 1. - f_c ) * fninz_mix(1)
     $                       + ( 1. - f_n ) * fninz_mix(2)
     $                       + ( 1. - f_o ) * fninz_mix(kel_o)
c
                        fcno_mul(k) = ( fninz_cno(4,k) - fninz_mix(4) )
     $                       / ( ( 1. - f_c )
     $                       * fninz_opalGS98(1,n_cnobeg)
     $                       + ( 1. - f_n )
     $                       * fninz_opalGS98(2,n_cnobeg)
     $                       + ( 1. - f_o )
     $                       * fninz_opalGS98(kel_o,n_cnobeg) )
c
                     else
c
                        del_co_orig =
     $                       ( 1. - f_c ) * fninz_opalGS98(1,n_cnobeg)
     $                       + ( 1. - f_o )
     $                       * fninz_opalGS98(kel_o,n_cnobeg)
                        fad_ne = max( 0.0 , min( 1.0 ,
     $                       ( fninz_opalGS98(4,j)
     $                       - fninz_opalGS98(4,n_cnobeg) )
     $                       / del_co_orig ) )
                        del_co = ( 1. - f_c ) * fninz_mix(1)
     $                       + ( 1. - f_o ) * fninz_mix(kel_o)
                        fninz_cno(2,k) = fninz_mix(2)
     $                       + ( 1. - fad_ne ) * del_co
                        fninz_cno(4,k) = fninz_mix(4) + fad_ne * del_co
c
                        fcno_mul(k) = del_co / del_co_orig
c
                     endif
c
                     sum_aini = 0.0
                     do i = 1, nel_zmix
                        xiz_cno(i,k) = fninz_cno(i,k) * atwt_opalGS98(i)
                        sum_aini = sum_aini + xiz_cno(i,k)
                     enddo
                     do i = 1, nel_zmix
                        xiz_cno(i,k) = xiz_cno(i,k) / sum_aini
                     enddo
c
                  enddo
c
               endif
c
               x1 = fninz_cno(1,1)
               x2 = fninz_cno(1,2)
               x3 = fninz_cno(1,3)
               x4 = fninz_cno(1,4)
c
               y1 = fninz_cno(2,1)
               y2 = fninz_cno(2,2)
               y3 = fninz_cno(2,3)
               y4 = fninz_cno(2,4)
c
               z1 = fninz_cno(3,1)
               z2 = fninz_cno(3,2)
               z3 = fninz_cno(3,3)
               z4 = fninz_cno(3,4)
c
               d = ( x2 - x1 ) * ( ( y3 - y1 ) * ( z4 - z1 )
     $                             - ( y4 - y1 ) * ( z3 - z1 ) )
     $              + ( x3 - x1 ) * ( ( y4 - y1 ) * ( z2 - z1 )
     $                             - ( y2 - y1 ) * ( z4 - z1 ) )
     $              + ( x4 - x1 ) * ( ( y2 - y1 ) * ( z3 - z1 )
     $                             - ( y3 - y1 ) * ( z2 - z1 ) )
c
               if ( d .eq. 0.0 ) stop
     $              ' STOP -- READCO Error: CNO-interp: D = 0. '
c
               fcno_fac(0,1) = ( x2 * ( y3 * z4 - y4 * z3 )
     $              + x3 * ( y4 * z2 - y2 * z4 )
     $              + x4 * ( y2 * z3 - y3 * z2 ) ) / d
               fcno_fac(1,1) = ( y2 * ( z4 - z3 )
     $              + y3 * ( z2 - z4 ) + y4 * ( z3 - z2 ) ) / d
               fcno_fac(2,1) = ( x2 * ( z3 - z4 )
     $              + x3 * ( z4 - z2 ) + x4 * ( z2 - z3 ) ) / d
               fcno_fac(3,1) = ( x2 * ( y4 - y3 )
     $              + x3 * ( y2 - y4 ) + x4 * ( y3 - y2 ) ) / d
c
               fcno_fac(0,2) = ( x1 * ( y4 * z3 - y3 * z4 )
     $              + x3 * ( y1 * z4 - y4 * z1 )
     $              + x4 * ( y3 * z1 - y1 * z3 ) ) / d
               fcno_fac(1,2) = ( y1 * ( z3 - z4 )
     $              + y3 * ( z4 - z1 ) + y4 * ( z1 - z3 ) ) / d
               fcno_fac(2,2) = ( x1 * ( z4 - z3 )
     $              + x3 * ( z1 - z4 ) + x4 * ( z3 - z1 ) ) / d
               fcno_fac(3,2) = ( x1 * ( y3 - y4 )
     $              + x3 * ( y4 - y1 ) + x4 * ( y1 - y3 ) ) / d
c
               fcno_fac(0,3) = ( x1 * ( y2 * z4 - y4 * z2 )
     $              + x2 * ( y4 * z1 - y1 * z4 )
     $              + x4 * ( y1 * z2 - y2 * z1 ) ) / d
               fcno_fac(1,3) = ( y1 * ( z4 - z2 )
     $              + y2 * ( z1 - z4 ) + y4 * ( z2 - z1 ) ) / d
               fcno_fac(2,3) = ( x1 * ( z2 - z4 )
     $              + x2 * ( z4 - z1 ) + x4 * ( z1 - z2 ) ) / d
               fcno_fac(3,3) = ( x1 * ( y4 - y2 )
     $              + x2 * ( y1 - y4 ) + x4 * ( y2 - y1 ) ) / d
c
               fcno_fac(0,4) = ( x1 * ( y3 * z2 - y2 * z3 )
     $              + x2 * ( y1 * z3 - y3 * z1 )
     $              + x3 * ( y2 * z1 - y1 * z2 ) ) / d
               fcno_fac(1,4) = ( y1 * ( z2 - z3 )
     $              + y2 * ( z3 - z1 ) + y3 * ( z1 - z2 ) ) / d
               fcno_fac(2,4) = ( x1 * ( z3 - z2 )
     $              + x2 * ( z1 - z3 ) + x3 * ( z2 - z1 ) ) / d
               fcno_fac(3,4) = ( x1 * ( y2 - y3 )
     $              + x2 * ( y3 - y1 ) + x3 * ( y1 - y2 ) ) / d
c
            endif
c
         endif
c
      endif
c			! get number and mass fraction heavier than Ne (in Z)
      fninz_heavy = 0.0
      xiz_heavy = 0.0
      d_fninz_u_heavy = 0.0
      s_ninzai_mix = fninz_mix(1) * atwt_opalGS98(1)
     $     + fninz_mix(2) * atwt_opalGS98(2)
     $     + fninz_mix(3) * atwt_opalGS98(3)
     $     + fninz_mix(4) * atwt_opalGS98(4)
      ds_ninzai_u = d_fninz_user(1) * atwt_opalGS98(1)
     $     + d_fninz_user(2) * atwt_opalGS98(2)
     $     + d_fninz_user(3) * atwt_opalGS98(3)
     $     + d_fninz_user(4) * atwt_opalGS98(4)
      do i = 5, nel_zmix
         fninz_heavy = fninz_heavy + fninz_mix(i)
         xiz_heavy = xiz_heavy + xiz_mix(i)
         d_fninz_u_heavy = d_fninz_u_heavy + d_fninz_user(i)
         s_ninzai_mix = s_ninzai_mix + fninz_mix(i) * atwt_opalGS98(i)
         ds_ninzai_u = ds_ninzai_u + d_fninz_user(i) * atwt_opalGS98(i)
      enddo
      fn_o_over_cno = fninz_mix(3)
     $     / ( fninz_mix(1) + fninz_mix(2) + fninz_mix(3) )
      fninz_co_mix = fninz_mix(1) + fninz_mix(3)
c					        ! set internal CNO-interp flags
      kdo_cno = kavail_cno * kuse_cno
      kdo_user = kavail_user * kuse_user
c					 ! set flag "finshed reading opacities"
      itime = 12345678
c
      return
      end
c
c******************************************************************************
c
      SUBROUTINE SPLINE(X,Y,N,Y2)
c     ===========================
c___
      PARAMETER ( NMAX=100 )
C
      DIMENSION X(N),Y(N),Y2(N),U(NMAX)
C
C     FIRST DERIVATIVES AT END POINTS USING CUBIC FIT
C===
      YP1 = ((Y(3)-Y(1))*(X(2)-X(1))**2
     $     -(Y(2)-Y(1))*(X(3)-X(1))**2)/
     $     ((X(3)-X(1))*(X(2)-X(1))*(X(2)-X(3)))
      YPN = ((Y(N-2)-Y(N))*(X(N-1)-X(N))**2
     $     -(Y(N-1)-Y(N))*(X(N-2)-X(N))**2)/
     $     ((X(N-2)-X(N))*(X(N-1)-X(N))*(X(N-1)-X(N-2)))
C
      Y2(1) = -0.5
      U(1) = (3./(X(2)-X(1)))*((Y(2)-Y(1))/(X(2)-X(1))-YP1)
      DO I = 2,N-1
         SIG = (X(I)-X(I-1))/(X(I+1)-X(I-1))
         P = SIG*Y2(I-1)+2.
         Y2(I) = (SIG-1.)/P
         U(I) = (6.*((Y(I+1)-Y(I))/(X(I+1)-X(I))-(Y(I)-Y(I-1))
     $        /(X(I)-X(I-1)))/(X(I+1)-X(I-1))-SIG*U(I-1))/P
      ENDDO
      QN = 0.5
      UN = (3./(X(N)-X(N-1)))*(YPN-(Y(N)-Y(N-1))/(X(N)-X(N-1)))
      Y2(N) = (UN-QN*U(N-1))/(QN*Y2(N-1)+1.)
      DO K = N-1,1,-1
         Y2(K) = Y2(K)*Y2(K+1)+U(K)
      ENDDO
      RETURN
      END
c
c******************************************************************************
c
      SUBROUTINE SPLINT(XA,YA,N,Y2A,X,Y,YP)
c     =====================================
c___
      DIMENSION XA(N),YA(N),Y2A(N)
C===
      KLO = 1
      KHI = N
      do while( KHI-KLO .GT. 1 )
         K = (KHI+KLO)/2
         IF ( XA(K) .GT. X ) THEN
            KHI = K
         ELSE
            KLO = K
         ENDIF
      enddo
      H = XA(KHI)-XA(KLO)
      IF ( H .EQ. 0. ) STOP ' STOP -- SPLINT: Bad XA input. '
      A = (XA(KHI)-X)/H
      B = (X-XA(KLO))/H
      Y = A*YA(KLO)+B*YA(KHI)+
     $     ((A**3-A)*Y2A(KLO)+(B**3-B)*Y2A(KHI))*(H**2)/6.
      YP = 0.05*  (  (-YA(KLO)+YA(KHI))/H
     $     +      ( -(3*A**2-1)*Y2A(KLO)
     $     +(3*B**2-1)*Y2A(KHI) )*H/6. )
      RETURN
      END
c
c******************************************************************************
c
      SUBROUTINE FITY
c     ===============
C
C  THIS ROUTINE MAKES SPLINE FITS FOR F AND FX, AND OBTAINS
C  FY AND FXY
C						! modified:
      COMMON/CST_OPAL_Z/ NRL,RLS,nset,tmax
      save /CST_OPAL_Z/
C
      PARAMETER ( IPR=20 )
C
      COMMON/CF_OPAL_Z/ F(85,IPR),FX(85,IPR),FY(85,IPR),FXY(85,IPR)
      save /CF_OPAL_Z/
c___
      DIMENSION A(IPR),B(IPR),AD(IPR),BD(IPR)
C===								    ! modified:
      DO I = 1,nset
         DO J = 1,NRL
            A(J) = F(I,J)
            B(J) = FX(I,J)
         ENDDO
C
         CALL GETD(A,NRL,AD,AP1,APN)
         CALL GETD(B,NRL,BD,BP1,BPN)
C
         FY(I,1) = AP1
         FY(I,NRL) = APN
         FXY(I,1) = BP1
         FXY(I,NRL) = BPN
         DO J = 2,NRL-1
            FY(I,J) =  -A(J)+A(J+1)-2.*AD(J)-AD(J+1)
            FXY(I,J) = -B(J)+B(J+1)-2.*BD(J)-BD(J+1)
         ENDDO
      ENDDO
C
      RETURN
      END
c
c******************************************************************************
c
      SUBROUTINE FITX
c     ===============
C
C  THIS ROUTINE IS USED ONLY AFTER SMOOTHING.
C  ITS FUNCTION IS TO RECOMPUTE FX USING SMOOTHED F.
C
      PARAMETER ( IPR=20 )
C					! modified:
      COMMON/CST_OPAL_Z/ NRL,RLS,nset,tmax
      save /CST_OPAL_Z/
c
      COMMON/CF_OPAL_Z/ F(85,IPR),FX(85,IPR),FY(85,IPR),FXY(85,IPR)
      save /CF_OPAL_Z/
C___
      DIMENSION A(85),D(85)
C===
      DO J = 1,NRL
C					! modified:
         DO I = 1,nset
            A(I) = F(I,J)
         ENDDO
C					! modified:
         CALL GETD(A,nset,D,AP1,APN)
         FX(1,J) = AP1
C					! modified:
         FX(nset,J) = APN
C					! modified:
         DO I = 2,nset-1
            FX(I,J) = -A(I)+A(I+1)-2.*D(I)-D(I+1)
         ENDDO
      ENDDO
C
      RETURN
      END
C
c******************************************************************************
c
      SUBROUTINE GETD(F,N,D,FP1,FPN)
c     ==============================
C
C  SIMPLIFIED CODE FOR SPLINE COEFFICIENTS, FOR CASE OF INTERVALS OF UNITY.
C___
      DIMENSION F(N),D(N),T(85)
C===
      FP1 = (-11.*F(1)+18.*F(2)-9.*F(3)+2.*F(4))/6.
      FPN = (11.*F(N)-18.*F(N-1)+9.*F(N-2)-2.*F(N-3))/6.
C
      D(1) = -.5
      T(1) = .5*(-F(1)+F(2)-FP1)
C
      DO J = 2,N-1
         D(J) = -1./(4.+D(J-1))
         T(J) = -D(J)*(F(J-1)-2.*F(J)+F(J+1)-T(J-1))
      ENDDO
C
      D(N) = (FPN+F(N-1)-F(N)-T(N-1))/(2.+D(N-1))
C
      DO J = N-1,1,-1
         D(J) = D(J)*D(J+1)+T(J)
      ENDDO
C
      RETURN
      END
C
c******************************************************************************
c
      SUBROUTINE INTERP(FLT,FLRHO,G,DGDT,DGDRHO,IERR)
c     ===============================================
C
C  GIVEN F,FX,FY AND FXY ON THE GRID POINTS, THIS ROUTINE
C  DOES BI-CUBIC INTERPOLATIONS USING METHODS DESCRIBED IN
C  Numerical Recipes, PP. 118 TO 120
C
      PARAMETER ( IPR=20 )
C						! modified:
      COMMON/CST_OPAL_Z/ NRL,RLS,nset,tmax
      save /CST_OPAL_Z/
C
      COMMON/CF_OPAL_Z/ F(85,IPR),FX(85,IPR),FY(85,IPR),FXY(85,IPR)
      save /CF_OPAL_Z/
c___
      DIMENSION B(16)
      LOGICAL IERR
C
C  EXTREME LIMITS ALLOWED ARE:-
C     (3.800-0.0125) TO (8.000+0.0125) FOR LOG10(T)
C     (RLS-0.125) TO (RLE+0.1254) FOR LOG10(R)
C     (ALLOWING FOR SMALL EXTRAPOLATIONS BEYOND TABULAR VALUES)
C
C     FUNCTION DEFINITIONS FOR CUBIC EXPANSION
C===
      FF(S,T) =    B( 1)+T*(B( 2)+T*(B( 3)+T*B( 4)))
     $     + S*(   B( 5)+T*(B( 6)+T*(B( 7)+T*B( 8)))
     $     + S*(   B( 9)+T*(B(10)+T*(B(11)+T*B(12)))
     $     + S*(   B(13)+T*(B(14)+T*(B(15)+T*B(16))) ) ) )
C
      FFX(S,T) =    B( 5)+T*(B( 6)+T*(B( 7)+T*B( 8)))
     $     + S*( 2*(B( 9)+T*(B(10)+T*(B(11)+T*B(12))))
     $     + S*( 3*(B(13)+T*(B(14)+T*(B(15)+T*B(16)))) ) )
C
      FFY(S,T) =    B( 2)+S*(B( 6)+S*(B(10)+S*B(14)))
     $     + T*( 2*(B( 3)+S*(B( 7)+S*(B(11)+S*B(15))))
     $     + T*( 3*(B( 4)+S*(B( 8)+S*(B(12)+S*B(16)))) ) )
C
C  Note that statement function FFXY is never used, and thus can be omitted.
C
c-noneed[						 ! FFXY is never used!
c-noneed;      FFXY(S,T) =  B( 6)+T*(2*B( 7)+3*T*B( 8))
c-noneed;     $     +S*(  2*B(10)+T*(4*B(11)+6*T*B(12))
c-noneed;     $     +S*(  3*B(14)+T*(6*B(15)+9*T*B(16)) ))
c-noneed]
C
C     BEGINNING OF EXECUTABLE STATEMENTS
C===
c-old;      IERR = .FALSE.
c				! values to use if there is an error-return:
      IERR = .TRUE.
      G = 9.999
      DGDT = 9.999
      DGDRHO = 9.999
C
      X = 20.*(FLT-3.800)+1.
c-less-accurate;      FLR = FLRHO+18.-3.*FLT
      FLR = FLRHO - 3. * ( FLT - 6. )
      Y = 2.*( FLR - RLS )+1.
C
      IF ( X .LT. 2. ) THEN
c-old;         IF ( X .LT. 0.75 ) THEN
c-old;            IERR = .TRUE.
c-old;         ELSE
c-old;            I = 1
c-old;         ENDIF
         IF ( X .LT. 0.75 ) RETURN
         I = 1
      ELSE IF ( X .GT. 84. ) THEN
c-old;         IF ( X .GT. 85.25 ) THEN
c-old;            IERR = .TRUE.
c-old;         ELSE
c-old;            I = 84
c-old;         ENDIF
         IF ( X .GT. 85.25 ) RETURN
         I = 84
      ELSE
         I = X
      ENDIF
      U = X-I
C
      IF ( Y .LT. 2. ) THEN
c-old;         IF ( Y .LT. 0.75 ) THEN
c-old;            IERR = .TRUE.
c-old;         ELSE
c-old;            J = 1
c-old;         ENDIF
         IF ( Y .LT. 0.75 ) RETURN
         J = 1
      ELSE IF ( Y .GT. NRL-1 ) THEN
c-old;         IF ( Y .GT. NRL+.25 ) THEN
c-old;            IERR = .TRUE.
c-old;         ELSE
c-old;            J = NRL-1
c-old;         ENDIF
         IF ( Y .GT. NRL+.25 ) RETURN
         J = NRL - 1
      ELSE
         J = Y
      ENDIF
      V = Y-J
C
c-old;      IF ( IERR ) THEN
c-old;         RETURN
c-old;      ENDIF
C
C  GIVEN FUNCTIONS AND DERIVATIVES AT GRID POINTS, COMPUTE COEFFICIENTS.
c
      B(1) = F(I,J)
      B(2) = FY(I,J)
      B(3) = 3*(-F(I,J)+F(I,J+1))-2*FY(I,J)-FY(I,J+1)
      B(4) = 2*(F(I,J)-F(I,J+1))+FY(I,J)+FY(I,J+1)
C
      B(5) = FX(I,J)
      B(6) = FXY(I,J)
      B(7) = 3*(-FX(I,J)+FX(I,J+1))-2*FXY(I,J)-FXY(I,J+1)
      B(8) = 2*(FX(I,J)-FX(I,J+1))+FXY(I,J)+FXY(I,J+1)
C
      B(9) = 3*(-F(I,J)+F(I+1,J))-2*FX(I,J)-FX(I+1,J)
      B(10) = 3*(-FY(I,J)+FY(I+1,J))-2*FXY(I,J)-FXY(I+1,J)
      B(11) = 9*(F(I,J)-F(I+1,J)+F(I+1,J+1)-F(I,J+1))
     $     +6*(FX(I,J)-FX(I,J+1)+FY(I,J)-FY(I+1,J))
     $     +4*FXY(I,J)
     $     +3*(FX(I+1,J)-FX(I+1,J+1)-FY(I+1,J+1)+FY(I,J+1))
     $     +2*(FXY(I,J+1)+FXY(I+1,J))
     $     +FXY(I+1,J+1)
      B(12) = 6*(-F(I,J)+F(I+1,J)-F(I+1,J+1)+F(I,J+1))
     $     +4*(-FX(I,J)+FX(I,J+1))
     $     +3*(-FY(I,J)+FY(I+1,J)+FY(I+1,J+1)-FY(I,J+1))
     $     +2*(-FX(I+1,J)+FX(I+1,J+1)-FXY(I,J)-FXY(I,J+1))
     $     -FXY(I+1,J)-FXY(I+1,J+1)
C
      B(13) = 2*(F(I,J)-F(I+1,J))+FX(I,J)+FX(I+1,J)
      B(14) = 2*(FY(I,J)-FY(I+1,J))+FXY(I,J)+FXY(I+1,J)
      B(15) = 6*(-F(I,J)+F(I+1,J)-F(I+1,J+1)+F(I,J+1))
     $     +4*(-FY(I,J)+FY(I+1,J))
     $     +3*(-FX(I,J)-FX(I+1,J)+FX(I+1,J+1)+FX(I,J+1))
     $     +2*(FY(I+1,J+1)-FY(I,J+1)-FXY(I,J)-FXY(I+1,J))
     $     -FXY(I+1,J+1)-FXY(I,J+1)
      B(16) = 4*(F(I,J)-F(I+1,J)+F(I+1,J+1)-F(I,J+1))
     $     +2*(FX(I,J)+FX(I+1,J)-FX(I+1,J+1)-FX(I,J+1)
     $     +FY(I,J)-FY(I+1,J)-FY(I+1,J+1)+FY(I,J+1))
     $     +FXY(I,J)+FXY(I+1,J)+FXY(I+1,J+1)+FXY(I,J+1)
C
C  GET G=LOG10(ROSS), DGDT=d LOG10(ROSS)/d LOG10(T),
C      DGDRHO=d LOG10(ROSS)/d LOG10(RHO)
c
      G = FF(U,V)
      DGDT = 20.*FFX(U,V)-6.*FFY(U,V)
      DGDRHO = 2.*FFY(U,V)
c
      IERR = .FALSE.
C
      RETURN
      END
c
c******************************************************************************
c
      SUBROUTINE SMOOTH
c     =================
C
C  THIS SUBROUTINE USES A 2-DIMENSIONAL GENERALISATION OF THE SMOOTHING
C  TECHNIQUES DESCRIBED ON PP. 644 TO 649 OF Numerical Recipes.
C
C  CONSIDER THE 25 POINTS DEFINED BY
C       I+n, n=-2,-1,0,1,2 AND J+m, m=-2,-1,0,1,2.
C  THE FUNCTION TO BE SMOOTHED IS FITTED TO A BI-CUBIC, INVOLVING
C  16 COEFFICIENTS, USING TECHNIQUES OF LEAST-SQUARES. THE SMOOTHED
C  FUNCTION (TEMPORARILY STORED IN FXY) IS GIVEN BY THE FITTED VALUE
C  AT THE POINT I AND J.
C
C  THE FITTING IS SHIFTED FOR POINTS CLOSE TO BOUNDARIES.
C
C
      PARAMETER ( IPR=20 )
C						! modified
      COMMON/CST_OPAL_Z/ NRL,RLS,nset,tmax
      save /CST_OPAL_Z/
c
      COMMON/CF_OPAL_Z/ F(85,IPR),FX(85,IPR),FY(85,IPR),FXY(85,IPR)
      save /CF_OPAL_Z/
C___
      DIMENSION GAM(6),BET(11),ALP(11)
c---
      DATA GAM/+0.0073469388,-0.0293877551,-0.0416326531,
     $     +0.1175510204,+0.1665306122,+0.2359183673/
      DATA BET/
     $     -0.0048979592,-0.0661224490,-0.0293877551,+0.0195918367,
     $     0.2644897959,+0.1175510204,-0.0783673469,+0.0277551020,
     $     0.3746938776,+0.1665306122,-0.1110204082/
      DATA ALP/
     $     -0.0844897959,-0.0048979592,+0.0073469388,+0.0012244898,
     $     0.3379591837,+0.0195918367,-0.0293877551,+0.4787755102,
     $     0.0277551020,-0.0416326531,-0.0069387755/
C===
      DO I = 3,nset-2 
C
         J = 1
         FXY(I,J) = 
     $        ALP(1)*( F(I-2,J  )+F(I+2,J  ) )
     $        +ALP(2)*( F(I-2,J+1)+F(I+2,J+1)+F(I-2,J+3)+F(I+2,J+3)
     $        +F(I-1,J+4)+F(I+1,J+4) )
     $        +ALP(3)*( F(I-2,J+2)+F(I+2,J+2) )
     $        +ALP(4)*( F(I-2,J+4)+F(I+2,J+4) )
     $        +ALP(5)*( F(I-1,J  )+F(I+1,J  ) )
     $        +ALP(6)*( F(I-1,J+1)+F(I+1,J+1)+F(I-1,J+3)+F(I+1,J+3) )
     $        +ALP(7)*( F(I-1,J+2)+F(I+1,J+2) )
     $        +ALP(8)*  F(I  ,J  )
     $        +ALP(9)*( F(I  ,J+1)+F(I  ,J+3) )
     $        +ALP(10)* F(I  ,J+2) +ALP(11)*F(I  ,J+4)
C
         J = 2
         FXY(I,J) = 
     $        BET(1)*( F(I-2,J-1)+F(I+2,J-1)+F(I-2,J+3)+F(I+2,J+3) )
     $        +BET(2)*( F(I-2,J  )+F(I+2,J  ) )
     $        +BET(3)*( F(I-2,J+1)+F(I+2,J+1) )
     $        +BET(4)*( F(I-2,J+2)+F(I+2,J+2)+F(I-1,J-1)+F(I+1,J-1)
     $        +F(I-1,J+3)+F(I+1,J+3) )
     $        +BET(5)*( F(I-1,J  )+F(I+1,J  ) )
     $        +BET(6)*( F(I-1,J+1)+F(I+1,J+1) )
     $        +BET(7)*( F(I-1,J+2)+F(I+1,J+2) )
     $        +BET(8)*( F(I  ,J-1)+F(I  ,J+3) )
     $        +BET(9)*F(I  ,J  ) +BET(10)*F(I  ,J+1) +BET(11)*F(I  ,J+2)
C
         DO J = 3,NRL-2
            FXY(I,J) = 
     $           GAM(1)*( F(I-2,J-2)+F(I-2,J+2)+F(I+2,J-2)+F(I+2,J+2) )
     $           +GAM(2)*( F(I-2,J+1)+F(I-2,J-1)+F(I-1,J-2)+F(I-1,J+2)
     $           +F(I+1,J-2)+F(I+1,J+2)+F(I+2,J-1)+F(I+2,J+1) )
     $           +GAM(3)*( F(I-2,J  )+F(I+2,J  )+F(I  ,J-2)+F(I  ,J+2) )
     $           +GAM(4)*( F(I-1,J-1)+F(I-1,J+1)+F(I+1,J-1)+F(I+1,J+1) )
     $           +GAM(5)*( F(I-1,J  )+F(I  ,J-1)+F(I  ,J+1)+F(I+1,J  ) )
     $           +GAM(6)*  F(I  ,J  )
         ENDDO
C
         J = NRL-1
         FXY(I,J) = 
     $        BET(1)*( F(I-2,J+1)+F(I+2,J+1)+F(I-2,J-3)+F(I+2,J-3) )
     $        +BET(2)*( F(I-2,J  )+F(I+2,J  ) )
     $        +BET(3)*( F(I-2,J-1)+F(I+2,J-1) )
     $        +BET(4)*( F(I-2,J-2)+F(I+2,J-2)+F(I-1,J+1)+F(I+1,J+1)
     $        +F(I-1,J-3)+F(I+1,J-3) )
     $        +BET(5)*( F(I-1,J  )+F(I+1,J  ) )
     $        +BET(6)*( F(I-1,J-1)+F(I+1,J-1) )
     $        +BET(7)*( F(I-1,J-2)+F(I+1,J-2) )
     $        +BET(8)*( F(I  ,J+1)+F(I  ,J-3) )
     $        +BET(9)*F(I  ,J  ) +BET(10)*F(I  ,J-1) +BET(11)*F(I  ,J-2)
C
         J = NRL
         FXY(I,J) = 
     $        ALP(1)*( F(I-2,J  )+F(I+2,J  ) )
     $        +ALP(2)*( F(I-2,J-1)+F(I+2,J-1)+F(I-2,J-3)+F(I+2,J-3)
     $        +F(I-1,J-4)+F(I+1,J-4) )
     $        +ALP(3)*( F(I-2,J-2)+F(I+2,J-2) )
     $        +ALP(4)*( F(I-2,J-4)+F(I+2,J-4) )
     $        +ALP(5)*( F(I-1,J  )+F(I+1,J  ) )
     $        +ALP(6)*( F(I-1,J-1)+F(I+1,J-1)+F(I-1,J-3)+F(I+1,J-3) )
     $        +ALP(7)*( F(I-1,J-2)+F(I+1,J-2) )
     $        +ALP(8)*  F(I  ,J  )
     $        +ALP(9)*( F(I  ,J-1)+F(I  ,J-3) )
     $        +ALP(10)* F(I  ,J-2) +ALP(11)*F(I  ,J-4)
C
      ENDDO
C			! modified
      DO I = 3,nset-2
         DO J = 1,NRL
            F(I,J) = FXY(I,J)
         ENDDO
      ENDDO
C
      RETURN
      END
C
c******************************************************************************
c
      subroutine opaltab
c     ==================
C
C  CODE FOR FITTING AND SMOOTHING OPAL DATA. ADAPTED FROM A CODE
C     WRITTEN BY MIKE SEATON (obtained june 1993)
C
C     OPAL DATA.
C     ASSUMES FIRST T6 = .0056341325 = 10.**(3.75-6.) ; LAST T6 = tmax = 10.
C     USES RECTANGULAR ARRAY FOR VARIABLES T6 AND LOG10(R)
C
C     (1) NSM=NUMBER OF PASSES THROUGH SMOOTHING FILTER.
C     USE OF NSM=1 OR 2 IS RECOMMENDED.
C     NO SMOOTHING WITH NSM=0
C     (2) RANGE FOR LOG10(R),
C     RLS=FIRST VALUE, RLE=LAST VALE
C     (RLS MUST BE FIRST VALUYE IN TABLE)
C
C  SUBROUTINE INTERP
C     AFTER PROCESSING, DATA ARE IN A FORM FOR USE OF
C               SUBROUTINE INTERP
C     WHICH GIVES LOG(ROSS) AND TWO FIRST DERIVATIVES FOR ANY
C     VALUES OF LOG(T) AND LOG(RHO). SEE BELOW FOR FURTHER
C     EXPLANATION.
C
C  OUTPUT FOR THE CASE OF NSM .GT. 0.
C     INTERP IS USED TO OBTAIN SMOOTHED DATA INTERPOLATED
C     BACK TO THE ORIGINAL OPAL MESH.
C
C  THE SUBROUTINES SPLINE AND SPLINT ARE ADAPTED FROM THOSE GIVE BY
C  W.H. Press, S.A. Teulolsky, W.T. Vettering and B.P. Flannery,
C  "Numerical Recipes in FORTRAN", 2nd edn., 1992, C.U.P.
C  OTHER REFERENCES ARE MADE TO METHODS DESCRIBED IN THAT BOOK.
C
      PARAMETER ( IP=100, IPR=20 )
c
      parameter ( nz=5, mx=5, mc=8, mo=8, nrm=19, nrb=1, nre=19,
     $     nr=nre+1-nrb, ntm=70, ntb=1, nt=ntm+1-ntb, nrm_p1=nrm+1 )
c
      common/alink_opal_z/ NTEMP,NSM,nrlow,nrhigh,RLE,t6arr(100),
     $     coff(100,nrm)
      save /alink_opal_z/
c						! modified:
      COMMON/CST_OPAL_Z/ NRL,RLS,nset,tmax
      save /CST_OPAL_Z/
c
      COMMON/CF_OPAL_Z/ F(85,IPR),FX(85,IPR),FY(85,IPR),FXY(85,IPR)
      save /CF_OPAL_Z/
c___
      DIMENSION U(IP),ROSSL(IP,IPR),V(IP),V2(IP)
c
c-noneed;      CHARACTER*1 HEAD(100)
c
      LOGICAL IERR
C===
      NRL = int(2.*(RLE-RLS)+1.00001)
C
C     STORE LOG10(T) IN U AND LOG10(ROSS) IN ROSSL
C     CHECK FIRST VALUE OF T6
c
      do j = 1,NRL
         ROSSL(1,j) = coff(1,j)
      enddo
c
      T6 = t6arr(1)
      U(1) = 6.+LOG10(T6)
c
C     SET ROSSL UP TO T6=t6arr(nset)
c
      NTEMP = 1
      do while( T6 .LT. Tmax )
         NTEMP = NTEMP+1
         do j = 1,NRL
            ROSSL(NTEMP,j) = coff(NTEMP,j)
         enddo
         T6 = t6arr(NTEMP)
         U(NTEMP) = 6.+LOG10(T6)
      enddo
c
      IF ( NTEMP .GT. IP ) THEN
         PRINT*,' OPALTAB: REQUIRE PARAMETER IP OF AT LEAST ',NTEMP
         STOP ' STOP -- OPALTAB ERROR: NTEMP > IP . '
      ENDIF
C
C
C     DEFINE VARIABLES
C         X=20.0*(LOG10(T)-3.80)+1
C         Y=2.0*(LOG10(R)-RLS)+1
C     USE INDICES I=1 TO nset AND J=1 TO NRL
C     X AND Y ARE SUCH THAT, ON MESH-POINT (I,J), X=I AND Y=J
C     OBTAIN:-
C         F(I,J)=LOG10(ROSS)
C         FX(I,J)=dF/dX
C         FY(I,J)=dF/dY
C         FXY(I,J)=ddF/dXdY
C
C
C     FIRST GET F AND FX, INTERPOLATING FROM OPAL T6 TO
C     INTERVAL OF 0.05 IN LOG10(T).
c
      DO J = 1,NRL
c
C        FOR EACH LOG10(R), STORE LOG10(ROSS) IN V(I)
c
         DO I = 1,NTEMP
            V(I) = ROSSL(I,J)
         ENDDO
C
C        GET FIRST DERIVATIVES AT END POINTS: done in SPLINE, using cubic fit
C
C        GET SECOND DERIVATIVES FOR SPLINE FIT: done by SPLINE
c
         CALL SPLINE(U,V,NTEMP,V2)
C
C        INTERPOLATE TO LOG10(T)=FLT, FLT=3.8(0.05)8.0
c							! modified:
         DO I = 1,nset
            FLT = 3.75+0.05*I
            CALL SPLINT(U,V,NTEMP,V2,FLT,F(I,J),FX(I,J))
         ENDDO
C
      ENDDO
C
C  OPTION FOR SMOOTHING
C
      IF ( NSM .GT. 0 ) THEN
         DO NS = 1,NSM
            CALL SMOOTH
         ENDDO
         CALL FITX
      ENDIF
C
C  GET FY AND FXY
C
      CALL FITY
C
C  THE ARRAYS F, FX, FY AND FXY ARE NOW STORED
C
C  CAN NOW DO INTERPOLATIONS USING
C       CALL INTERP(FLT,FLRHO,G,DGDT,DGDRHO,IERR)
C       INPUT IS FLT=LOG10(T), FLRHO=LOG10(RHO)
C       OUTPUT IS G=LOG10(ROSS)
C              DGDT=dG/d(LOG10(T))
C            DGDRHO=dG/d(LOG10(RHO))
C              IERR=.TRUE. IF INPUT FLT, FLRHO ARE OUT-OF-RANGE,
C                          ELSE IERR=.FALSE.
C
C INTERPOLATE BACK TO OPAL POINTS
C
      IF ( NSM .GT. 0 ) THEN
c
         do il = 1,NRL
            coff(1,il) = ROSSL(1,il)
         enddo
c
         DO K = 2,NTEMP
            FLT = U(K)
            DO IL = nrlow,nrhigh
               FLR = RLS+.5*(IL-1)
               FLRHO = FLR-18.+3.*FLT
               CALL INTERP(FLT,FLRHO,G,DGDT,DGDRHO,IERR)
               IF ( IERR ) THEN
                  stop ' STOP -- OPALTAB: INTERP T/rho range error. '
               ENDIF
               V(IL) = G
            ENDDO
            do il = nrlow,nrhigh
               coff(K,il) = V(il)
            enddo
         ENDDO
c
      ENDIF
C
      return
      END
c
c***********************************************************************
c
      subroutine open_chk_zip( iu, fname, igzip, cmsg )
c     =================================================
c
c  Open a file, possibly decompressing it first.
c  If iu < 0, then it is not a fatal error if file is not found.
c  If iu < -99, then do not actually open or decompress the file.
c
c  Return  igzip = -99999 if file is not found
c          igzip = 0 if file is not compressed
c          igzip = 1 if file is gzip-compressed ("*.gz")
c          igzip = 2 if file is bzip2-compressed ("*.bz2")
c          igzip = -1 if file is compressed ("*.Z")
c
      character*(*) fname
      character*(*) cmsg
c
      character*511 ctmp
c
      logical lxst
c===
      last = lnblnk( fname )
c
      if ( last .le. 0 ) stop
     $     ' STOP -- OPEN_CHK_ZIP Error: blank file name. '
c
      call inqfil( fname, lxst )
c
      if ( lxst ) then
         igzip = 0
         if ( iu .lt. -99 ) return
      else if ( last .gt. 497 ) then
         stop ' STOP -- OPEN_CHK_ZIP Error: file name too long. '
      else
         ctmp = fname(1:last) // '.gz'
         call inqfil( ctmp, lxst )
         if ( lxst ) then
            igzip = 1
            if ( iu .lt. -99 ) return
            ctmp = 'gunzip ' // fname(1:last) // '.gz'
            call system( ctmp )
         else
            ctmp = fname(1:last) // '.Z'
            call inqfil( ctmp, lxst )
            if ( lxst ) then
               igzip = -1
               if ( iu .lt. -99 ) return
               ctmp = 'uncompress ' // fname(1:last) // '.Z'
               call system( ctmp )
            else
               ctmp = fname(1:last) // '.bz2'
               call inqfil( ctmp, lxst )
               if ( lxst ) then
                  igzip = 2
                  if ( iu .lt. -99 ) return
                  ctmp = 'bunzip2 ' // fname(1:last) // '.bz2'
                  call system( ctmp )
               else if ( iu .lt. 0 ) then
                  igzip = -99999
                  return
               else
                  write(6,'(" ",a)') cmsg
                  write(6,'(" ",a)') fname
                  stop ' STOP -- OPEN_CHK_ZIP Error: file not found. '
               endif
            endif
         endif
      endif
c
      if ( iu .gt. -100 ) call opoldr( iabs(iu), fname )
c
      return
      end
c
c************************************************************************
c
      subroutine close_chk_zip( iu, fname, igzip )
c     ============================================
c
      character*(*) fname
c
      character*511 ctmp
c
      close(iu)
c
      if ( igzip .gt. 1 ) then
c
         ctmp = 'bzip2 ' // fname
         call system( ctmp )
c
      else if ( igzip .gt. 0 ) then
c
         ctmp = 'gzip ' // fname
         call system( ctmp )
c
      else if ( igzip .lt. 0 ) then
c
         ctmp = 'compress ' // fname
         call system( ctmp )
c
      endif
c
      return
      end
c
c************************************************************************
c
      subroutine quadslsto( i, x, x1, x2, x3 )
c     ========================================
c
c  Storage for x,dx_i values that need not be computed on each call (see "ic");
c  NOTE that this same storage is used by all of QUADSL, QDERSL
c
      common/c_quadsl_opal_z/ xo21(10), xo32(10), x01(10), x02(10),
     $     x03(10), x0230o32(10), x0202o32(10), x023021o3231(10),
     $     x0203o31(10), x0201o31(10), x0201o21(10), x0202o21(10),
     $     x020132o2131(10), ixvs2(10)
      save /c_quadsl_opal_z/
c
      dimension xx(4)
c
      xx(4) = x
      xx(2) = x2
c
      if ( xx(4) .eq. xx(2) ) then
c
         ixvs2(i) = 0
c
      else
c
         xx(1) = x1
         xx(3) = x3
c
         xo21(i) = 1.0 / ( xx(2) - xx(1) )
         xo32(i) = 1.0 / ( xx(3) - xx(2) )
c
         x02(i) = xx(4) - xx(2)
c
         tmp = x02(i) / ( xx(3) - xx(1) )
         x0201o31(i) = tmp * ( xx(4) - xx(1) )
         x0203o31(i) = tmp * ( xx(4) - xx(3) )
c
         if ( xx(1) .lt. xx(3) ) then
c
            if ( xx(4) .lt. xx(2) ) then
c
               ixvs2(i) = -1
c
               x01(i) = xx(4) - xx(1)
c
               tmp = x02(i) * xo21(i)
               x0201o21(i) = tmp * x01(i)
               x0202o21(i) = tmp * x02(i)
c
               x020132o2131(i) = x0201o21(i) * ( xx(3) - xx(2) )
     $              / ( xx(3) - xx(1) )
c
            else
c
               ixvs2(i) = 1
c
               x03(i) = xx(4) - xx(3)
c
               tmp = x02(i) * xo32(i)
               x0230o32(i) = ( xx(3) - xx(4) ) * tmp
               x0202o32(i) = x02(i) * tmp
c
               x023021o3231(i) = x0230o32(i) * ( xx(2) - xx(1) )
     $              / ( xx(3) - xx(1) )
c
            endif
c
         else if ( xx(4) .gt. xx(2) ) then
c
            ixvs2(i) = -1
c
            x01(i) = xx(4) - xx(1)
c
            tmp = x02(i) * xo21(i)
            x0201o21(i) = tmp * x01(i)
            x0202o21(i) = tmp * x02(i)
c
            x020132o2131(i) = x0201o21(i) * ( xx(3) - xx(2) )
     $           / ( xx(3) - xx(1) )
c
         else
c
            ixvs2(i) = 1
c
            x03(i) = xx(4) - xx(3)
c
            tmp = x02(i) * xo32(i)
            x0230o32(i) = ( xx(3) - xx(4) ) * tmp
            x0202o32(i) = x02(i) * tmp
c
            x023021o3231(i) = x0230o32(i) * ( xx(2) - xx(1) )
     $           / ( xx(3) - xx(1) )
c
         endif
c
      endif
c
      return
      end
c
c************************************************************************
c
      function quadslget( i, y1, y2, y3 )
c     ===================================
c
c..... this function performs a quadratic interpolation, trying to avoid
c      spurious wiggles at point where the slope changes by a large amount
c
      common/c_quadsl_opal_z/ xo21(10), xo32(10), x01(10), x02(10),
     $     x03(10), x0230o32(10), x0202o32(10), x023021o3231(10),
     $     x0203o31(10), x0201o31(10), x0201o21(10), x0202o21(10),
     $     x020132o2131(10), ixvs2(10)
      save /c_quadsl_opal_z/
c
      if ( ixvs2(i) .eq. 0 ) then
         quadslget = y2
         return
      endif
c
      s21 = ( y2 - y1 ) * xo21(i)
      s32 = ( y3 - y2 ) * xo32(i)
      as21 = abs( s21 )
      as32 = abs( s32 )
c
      if ( 6.0 * as21 .le. as32 ) then
c
         if ( ixvs2(i) .le. 0 ) then
            quadslget = x02(i) * s21 + y2
         else
            quadslget = x0230o32(i) * s21 + x0202o32(i) * s32 + y2
         endif
c
      else if ( 2.0 * as21 .lt. as32 ) then
c
         omf_ds = ( 1.5 - as32 / ( 4.0 * as21 ) ) * ( s32 - s21 )
         if ( ixvs2(i) .le. 0 ) then
            quadslget = omf_ds * x0201o31(i) + x01(i) * s21 + y1
         else
            quadslget = x0230o32(i) * s21 + x0202o32(i) * s32
     $           + omf_ds * x023021o3231(i) + y2
         endif
c
      else if ( 2.0 * as32 .ge. as21 ) then
c
         quadslget = x0201o31(i) * s32 - x0203o31(i) * s21 + y2
c
      else if ( 6.0 * as32 .gt. as21 ) then
c
         omf_ds = ( 1.5 - as21 / ( 4.0 * as32 ) ) * ( s32 - s21 )
         if ( ixvs2(i) .ge. 0 ) then
            quadslget = omf_ds * x0203o31(i) + x03(i) * s32 + y3
         else
            quadslget = x0201o21(i) * s32 - x0202o21(i) * s21
     $           - omf_ds * x020132o2131(i) + y2
         endif
c
      else if ( ixvs2(i) .ge. 0 ) then
         quadslget = x02(i) * s32 + y2
      else
         quadslget = x0201o21(i) * s32 - x0202o21(i) * s21 + y2
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine qderslsto( i, x, x1, x2, x3 )
c     ========================================
c
c  Storage for x,dx_i values that need not be computed on each call;
c  NOTE that this same storage is used by all of QUADSL, QDERSL, QCHKSL
c
      common/c_quadsl_opal_z/ xo21(10), xo32(10), x01(10), x02(10),
     $     x03(10), x0230o32(10), x0202o32(10), x023021o3231(10),
     $     x0203o31(10), x0201o31(10), x0201o21(10), x0202o21(10),
     $     x020132o2131(10), ixvs2(10)
      save /c_quadsl_opal_z/
c
c  Storage for quantities needed for derivatives
c
      common/c_qdersl_opal_z/ x01o31(10), x30o31(10), x30p20o31(10),
     $     x02p01o31(10), x30p20o32(10), x02o32two(10), x02p01o21(10),
     $     x30p2021o3231(10), x02p03o31(10), x02o21two(10),
     $     x02p0132o2131(10)
      save /c_qdersl_opal_z/
c
      dimension xx(6)
c
      xx(1) = x1
      xx(2) = x2
      xx(3) = x3
      xx(4) = x
c
      xo21(i) = 1.0 / ( xx(2) - xx(1) )
      xo32(i) = 1.0 / ( xx(3) - xx(2) )
c
      xx(5) = 1.0 / ( xx(3) - xx(1) )
c
      if ( xx(4) .eq. xx(2) ) then
c
         ixvs2(i) = 0
c
         x01o31(i) = ( xx(4) - xx(1) ) * xx(5)
         x30o31(i) = ( xx(3) - xx(4) ) * xx(5)
c
      else
c
         x02(i) = xx(4) - xx(2)
c
         xx(6) = x02(i) * xx(5)
         x0201o31(i) = xx(6) * ( xx(4) - xx(1) )
         x0203o31(i) = xx(6) * ( xx(4) - xx(3) )
c
         x30p20o31(i) = ( ( xx(3) - xx(4) ) - x02(i) ) * xx(5)
         x02p01o31(i) = ( x02(i) + ( xx(4) - xx(1) ) ) * xx(5)
c
         if ( xx(1) .lt. xx(3) ) then
c
            if ( xx(4) .lt. xx(2) ) then
c
               ixvs2(i) = -1
c
               x01(i) = xx(4) - xx(1)
c
               xx(6) = x02(i) * xo21(i)
               x0201o21(i) = xx(6) * x01(i)
               x0202o21(i) = xx(6) * x02(i)
c
               xx(6) = ( xx(3) - xx(2) ) * xx(5)
               x020132o2131(i) = x0201o21(i) * xx(6)
c
               x02p01o21(i) = ( x02(i) + x01(i) ) * xo21(i)
               x02o21two(i) = 2.0 * x02(i) * xo21(i)
c
               x02p0132o2131(i) = x02p01o21(i) * xx(6)
c
            else
c
               ixvs2(i) = 1
c
               x03(i) = xx(4) - xx(3)
c
               xx(6) = x02(i) * xo32(i)
               x0230o32(i) = ( xx(3) - xx(4) ) * xx(6)
               x0202o32(i) = x02(i) * xx(6)
c
               xx(6) = ( xx(2) - xx(1) ) * xx(5)
               x023021o3231(i) = x0230o32(i) * xx(6)
c
               x30p20o32(i) = ( ( xx(3) - xx(4) ) - x02(i) ) * xo32(i)
               x02o32two(i) = 2.0 * x02(i) * xo32(i)
c
               x30p2021o3231(i) = x30p20o32(i) * xx(6)
c
               x02p03o31(i) = ( x02(i) + x03(i) ) * xx(5)
c
            endif
c
         else if ( xx(4) .gt. xx(2) ) then
c
            ixvs2(i) = -1
c
            x01(i) = xx(4) - xx(1)
c
            xx(6) = x02(i) * xo21(i)
            x0201o21(i) = xx(6) * x01(i)
            x0202o21(i) = xx(6) * x02(i)
c
            xx(6) = ( xx(3) - xx(2) ) * xx(5)
            x020132o2131(i) = x0201o21(i) * xx(6)
c
            x02p01o21(i) = ( x02(i) + x01(i) ) * xo21(i)
            x02o21two(i) = 2.0 * x02(i) * xo21(i)
c
            x02p0132o2131(i) = x02p01o21(i) * xx(6)
c
         else
c
            ixvs2(i) = 1
c
            x03(i) = xx(4) - xx(3)
c
            xx(6) = x02(i) * xo32(i)
            x0230o32(i) = ( xx(3) - xx(4) ) * xx(6)
            x0202o32(i) = x02(i) * xx(6)
c
            xx(6) = ( xx(2) - xx(1) ) * xx(5)
            x023021o3231(i) = x0230o32(i) * xx(6)
c
            x30p20o32(i) = ( ( xx(3) - xx(4) ) - x02(i) ) * xo32(i)
            x02o32two(i) = 2.0 * x02(i) * xo32(i)
c
            x30p2021o3231(i) = x30p20o32(i) * xx(6)
c
            x02p03o31(i) = ( x02(i) + x03(i) ) * xx(5)
c
         endif
c
      endif
c
      return
      end
c
c******************************************************************************
c
      subroutine qderslget( i, y1, y2, y3, y, dydx )
c     ==============================================
c
c..... this subroutine performs a quadratic interpolation, trying to avoid
c      spurious wiggles at point where the slope changes by a large amount;
c      it is identical to the function quadsl, except that it also computes
c      the derivative dydx of the quadratic at x, as well as y
c
c  Storage for x,dx_i values that need not be computed on each call (see "ic");
c  NOTE that this same storage is used by all of QUADSL, QDERSL
c
      common/c_quadsl_opal_z/ xo21(10), xo32(10), x01(10), x02(10),
     $     x03(10), x0230o32(10), x0202o32(10), x023021o3231(10),
     $     x0203o31(10), x0201o31(10), x0201o21(10), x0202o21(10),
     $     x020132o2131(10), ixvs2(10)
      save /c_quadsl_opal_z/
c
      common/c_qdersl_opal_z/ x01o31(10), x30o31(10), x30p20o31(10),
     $     x02p01o31(10), x30p20o32(10), x02o32two(10), x02p01o21(10),
     $     x30p2021o3231(10), x02p03o31(10), x02o21two(10),
     $     x02p0132o2131(10)
      save /c_qdersl_opal_z/
c
      s21 = ( y2 - y1 ) * xo21(i)
      s32 = ( y3 - y2 ) * xo32(i)
      as21 = abs( s21 )
      as32 = abs( s32 )
c
      if ( ixvs2(i) .eq. 0 ) then
         if ( 6.0 * as21 .le. as32 ) then
            dydx = s21
         else if ( 2.0 * as21 .lt. as32 ) then
            omf = 1.5 - as32 / ( 4.0 * as21 )
            dydx = s21 - omf * x01o31(i) * ( s21 - s32 )
         else if ( 2.0 * as32 .ge. as21 ) then
            dydx = x30o31(i) * s21 + x01o31(i) * s32
         else if ( 6.0 * as32 .gt. as21 ) then
            omf = 1.5 - as21 / ( 4.0 * as32 )
            dydx = s32 - omf * x30o31(i) * ( s32 - s21 )
         else
            dydx = s32
         endif
         y = y2
         return
      endif
c
      if ( 6.0 * as21 .le. as32 ) then
c
         if ( ixvs2(i) .le. 0 ) then
            y = x02(i) * s21 + y2
            dydx = s21
         else
            y = x0230o32(i) * s21 + x0202o32(i) * s32 + y2
            dydx = x30p20o32(i) * s21 + x02o32two(i) * s32
         endif
c
      else if ( 2.0 * as21 .lt. as32 ) then
c
         omf_ds = ( 1.5 - as32 / ( 4.0 * as21 ) ) * ( s32 - s21 )
         if ( ixvs2(i) .le. 0 ) then
            y = omf_ds * x0201o31(i) + x01(i) * s21 + y1
            dydx = s21 + omf_ds * x02p01o31(i)
         else
            y = x0230o32(i) * s21 + x0202o32(i) * s32
     $           + omf_ds * x023021o3231(i) + y2
            dydx = x30p20o32(i) * s21 + x02o32two(i) * s32
     $           + omf_ds * x30p2021o3231(i)
         endif
c
      else if ( 2.0 * as32 .ge. as21 ) then
c
         y = x0201o31(i) * s32 - x0203o31(i) * s21 + y2
         dydx = x30p20o31(i) * s21 + x02p01o31(i) * s32
c
      else if ( 6.0 * as32 .gt. as21 ) then
c
         omf_ds = ( 1.5 - as21 / ( 4.0 * as32 ) ) * ( s32 - s21 )
         if ( ixvs2(i) .ge. 0 ) then
            y = omf_ds * x0203o31(i) + x03(i) * s32 + y3
            dydx = s32 + omf_ds * x02p03o31(i)
         else
            y = x0201o21(i) * s32 - x0202o21(i) * s21
     $           - omf_ds * x020132o2131(i) + y2
            dydx = x02p01o21(i) * s32 - x02o21two(i) * s21
     $           - omf_ds * x02p0132o2131(i)
         endif
c
      else if ( ixvs2(i) .ge. 0 ) then
         y = x02(i) * s32 + y2
         dydx = s32
      else
         y = x0201o21(i) * s32 - x0202o21(i) * s21 + y2
         dydx = x02p01o21(i) * s32 - x02o21two(i) * s21
      endif
c
      return
      end
c
c************************************************************************
c
      subroutine qchkslsto( i, x, x1, x2, x3 )
c     ========================================
c
c  QCHKSL is used only for Ferguson et al. 2005 molecular opacities at the
c  highest X-interval; thus one can assume x1 < x2 and ( x2 < x3 or x2 = x3 ).
c
      parameter ( ratbeg=0.08, ratful=0.04, ratdel=1./(ratbeg-ratful) )
c
      common /c_qchksl_opal_z/ x01o21p31(10), facq(10), omfq(10),
     $     iokq(10)
      save /c_qchksl_opal_z/
c
      dxrat = abs( x3 - x2 ) / abs( x3 - x1 )
      if ( dxrat .ge. ratbeg ) then
         iokq(i) = 1
         call quadslsto( i, x, x1, x2, x3 )
      else
         x01o21p31(i) = ( x - x1 )
     $        / ( ( x2 - x1 ) + ( x3 - x1 ) )
         if ( dxrat .gt. ratful ) then
            iokq(i) = 0
            facq(i) = ( dxrat - ratful ) * ratdel
            omfq(i) = 1.0 - facq(i)
            call quadslsto( i, x, x1, x2, x3 )
         else
            iokq(i) = -1
            facq(i) = 0.
         endif
      endif
c
      return
      end
c
c************************************************************************
c
      function qchkslget( i, y1, y2, y3 )
c     ===================================
c
c..... if x2 was not too close to x3, then this function calls
c        quadslget(i,y1,y2,y3) to perform a quadratic interpolation;
c      if x2 and x3 were too close together to make a quadratic interpolation
c        reasonable, something more nearly linear is used instead.
c
      common /c_qchksl_opal_z/ x01o21p31(10), facq(10), omfq(10),
     $     iokq(10)
      save /c_qchksl_opal_z/
c
      if ( iokq(i) .gt. 0 ) then
         qchkslget = quadslget( i, y1, y2, y3 )
      else if ( iokq(i) .lt. 0 ) then
         qchkslget = y1 + x01o21p31(i)
     $        * ( ( y2 - y1 ) + ( y3 - y1 ) )
      else
         qchkslget = omfq(i) * ( y1 + x01o21p31(i)
     $        * ( ( y2 - y1 ) + ( y3 - y1 ) ) )
     $        + facq(i) * quadslget( i, y1, y2, y3 )
      endif
c
      return
      end
c
c************************************************************************
c
      subroutine qchksto( i, x, x1, x2, x3 )
c     --------------------------------------
c
c      NOTE that if a quadratic is fitted through 3 points with a large
c      interval R=(x2-x1) with values differing by D=(y2-y1), next to a much
c      smaller interval r=(x3-x2) with values differing by d=(y3-y2), and
c      the close-together points y2 and y3 have a relative error E, then
c      at the middle of the large interval R this error is magnified by
c      a factor of (1/4)(R/r).  At the middle of the interval R, the
c      difference between a linear and a quadratic is (1/4)[D-(R/r)d];
c      if this is less than the magnified error (1/4)(R/r)E, i.e.,
c      if E > | (r/R)D - d | , then the linear fit is better.  In QCHKGET, a
c      quadratic-error magnification of nearly 3 is allowed (R/r=11.5) before
c      beginning to switch over to linear interpolation; the switch-over is
c      complete at R/r=24.  The ratios used in the code are actually r/(r+R).
c
      parameter ( small_1m6=1.e-6 )
c
      parameter ( ratbeg=0.08, ratful=0.04, ratdel=1./(ratbeg-ratful) )
c
c  Storage for factors that need not be computed on each call.
c
      common/c_qchk_opal_z/ facq(30),dxinvq(30),omfq(30),
     $     iokq(30),iloq(30),i1q(30),i2q(30),lin(30)
      save /c_qchk_opal_z/
c
c  NOTE that QCHKSTO may store the same values as QUADSTO; if this is so,
c  then QCHKGET will use these stored values in the same manner as QUADGET.
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c
      dimension xx(3), r(3)
c
      xx(1) = x1
      xx(2) = x2
      xx(3) = x3
c					! linear extrapolation for x < x1 < x3:
c
      if ( x .lt. xx(1) .and. xx(3) - xx(1) .gt. small_1m6 ) then
c
         lin(i) = 1
c
         xloq = max( xx(2) - xx(1) , small_1m6 )
         omf = max( 0.0 , min( 1.0 , ( xx(3) - xx(1) ) / xloq ) )
         omfq(i) = omf * ( x - xx(1) ) / ( xx(3) - xx(1) )
         facq(i) = ( 1. - omf ) * ( x - xx(1) ) / xloq
c
         return
c
      endif
c					! otherwise:
      lin(i) = 0
c
      r(1) = abs( xx(3) - xx(2) )
      r(2) = abs( xx(3) - xx(1) )
      r(3) = abs( xx(2) - xx(1) )
c
      dxrat = min(r(1),r(2),r(3))/max(r(1),r(2),r(3))
c
      if ( dxrat .ge. ratbeg ) then
         iokq(i) = 1
         tmp = ( x - xx(2) ) / ( xx(3) - xx(1) )
         a21(i) = tmp * ( xx(3) - x ) / ( xx(2) - xx(1) )
         a32(i) = tmp * ( x - xx(1) ) / ( xx(3) - xx(2) )
      else
         if ( r(3) .lt. min(r(1),r(2)) ) then
            iloq(i) = 3
            i1q(i) = 1
            i2q(i) = 2
            dxinvq(i) = ( x - xx(3) )
     $           / ( ( xx(1) + xx(2) ) * 0.5 - xx(3) )
         else if ( r(2) .lt. r(1) ) then
            iloq(i) = 2
            i1q(i) = 3
            i2q(i) = 1
            dxinvq(i) = ( x - xx(2) )
     $           / ( ( xx(3) + xx(1) ) * 0.5 - xx(2) )
         else
            iloq(i) = 1
            i1q(i) = 2
            i2q(i) = 3
            dxinvq(i) = ( x - xx(1) )
     $           / ( ( xx(2) + xx(3) ) * 0.5 - xx(1) )
         endif
         if ( dxrat .gt. ratful ) then
            iokq(i) = 0
            facq(i) = ( dxrat - ratful ) * ratdel
            omfq(i) = 1. - facq(i)
            tmp = ( x - xx(2) ) / ( xx(3) - xx(1) )
            a21(i) = tmp * ( xx(3) - x ) / ( xx(2) - xx(1) )
            a32(i) = tmp * ( x - xx(1) ) / ( xx(3) - xx(2) )
         else
            iokq(i) = -1
            facq(i) = 0.
            omfq(i) = 1.
         endif
      endif
c
      return
      end
c
c************************************************************************
c
      function qchkget( i, y1, y2, y3 )
c     ---------------------------------
c
c..... if x < x1 < x3, then linear extrapolation is used (using values at x1
c       and x3; value at x2 is ignored, unless x2 > x3, which should not be);
c  otherwise:
c      if x2 was not too close to either x3 or x1, then this function calls
c       quadget(i,y1,y2,y3) to perform a quadratic interpolation;
c      if x2 and x3 (or x2 and x1) were too close together to make a quadratic
c       interpolation reasonable, something more nearly linear is used instead.
c
      common/c_qchk_opal_z/ facq(30),dxinvq(30),omfq(30),
     $     iokq(30),iloq(30),i1q(30),i2q(30),lin(30)
      save /c_qchk_opal_z/
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c
      dimension yy(3)
c
      if ( lin(i) .gt. 0 ) then
         qchkget = ( y2 - y1 ) * facq(i) + ( y3 - y1 ) * omfq(i) + y1
      else if ( iokq(i) .gt. 0 ) then
         qchkget = a21(i) * ( y2 - y1 ) + a32(i) * ( y3 - y2 ) + y2
      else
         yy(1) = y1
         yy(2) = y2
         yy(3) = y3
         if ( iokq(i) .lt. 0 ) then
            qchkget = ( ( yy(i1q(i)) + yy(i2q(i)) ) * 0.5
     $           - yy(iloq(i)) ) * dxinvq(i) + yy(iloq(i))
         else
            qchkget = ( ( ( yy(i1q(i)) + yy(i2q(i)) ) * 0.5
     $           - yy(iloq(i)) ) * dxinvq(i) + yy(iloq(i)) ) * omfq(i)
     $           + ( a21(i) * ( yy(2) - yy(1) )
     $           + a32(i) * ( yy(3) - yy(2) ) + yy(2) ) * facq(i)
         endif
      endif
c
      return
      end
c
c************************************************************************
c
      subroutine qderNsto( i, nmore, x, x1, x2, x3, x4 )
c     --------------------------------------------------
c
      common /cNquad_opal_z/ f21(30), f32(30), f43(30),
     $     g21(30), g32(30), g43(30)
      save /cNquad_opal_z/
c				! 4-point interpolation:
      if ( nmore .eq. 3 ) then
c
         t2 = x - x2
c
         t21 = ( x3 - x1 ) * ( x2 - x1 )
         t32 = ( x3 - x1 ) * ( x3 - x2 )
c
         a21 = t2 * ( x3 - x ) / t21
         a32 = t2 * ( x - x1 ) / t32
         d21 = ( ( x3 - x ) - t2 ) / t21
         d32 = ( t2 + ( x - x1 ) ) / t32
c
         xinv32 = 1.0 / ( x3 - x2 )
c
         fhi = t2 * xinv32
         flo = 1.0 - fhi
c
         t3 = x - x3
c
         u32 = ( x4 - x2 ) * ( x3 - x2 )
         u43 = ( x4 - x2 ) * ( x4 - x3 )
c
         b32 = t3 * ( x4 - x ) / u32
         b43 = t3 * t2 / u43
         e32 = ( ( x4 - x ) - t3 ) / u32
         e43 = ( t2 + t3 ) / u43
c
         f21(i) = flo * a21
         f43(i) = fhi * b43
c
         f32(i) = fhi + ( b32 - a32 ) * fhi + a32
c
         g21(i) = flo * d21 - a21 * xinv32
         g43(i) = fhi * e43 + b43 * xinv32
c
         g32(i) = ( 1.0 + b32 - a32 ) * xinv32
     $        + ( e32 - d32 ) * fhi + d32
c						! 3-point interp, or extrap:
      else if ( nmore .eq. 2 ) then
c
         fhi = ( x - x3 ) / ( x3 - x2 )
c
         if ( fhi .ge. 1.0 ) then
c
            f21(i) = 0.0
            f32(i) = fhi + 1.0
c
            g21(i) = 0.0
            g32(i) = 1.0 / ( x3 - x2 )
c
         else if ( fhi .gt. 0.0 ) then
c
            t1 = ( fhi - 1.0 ) / ( x3 - x1 )
            tmp = t1 * ( fhi - 1.0 ) * ( x - x3 )
            t2 = ( x2 - x3 ) / ( x2 - x1 )
c
            f21(i) = t2 * tmp
            f32(i) = fhi + 1.0 + tmp
c
            tmp = t1 * ( fhi + fhi + fhi - 1.0 )
c
            g21(i) = t2 * tmp
            g32(i) = tmp + 1.0 / ( x3 - x2 )
c
         else
c
            flo = ( x - x1 ) / ( x2 - x1 )
c
            if ( flo .le. -1.0 ) then
c
               f21(i) = flo - 1.0
               f32(i) = 0.0
c
               g21(i) = 1.0 / ( x2 - x1 )
               g32(i) = 0.0
c
            else if ( flo .lt. 0.0 ) then
c
               t1 = ( flo + 1.0 ) / ( x3 - x1 )
               tmp = t1 * ( flo + 1.0 ) * ( x - x1 )
               t2 = ( x1 - x2 ) / ( x3 - x2 )
c
               f21(i) = flo - 1.0 + tmp
               f32(i) = t2 * tmp
c
               tmp = t1 * ( flo + flo + flo + 1.0 )
c
               g21(i) = tmp + 1.0 / ( x2 - x1 )
               g32(i) = t2 * tmp
c
            else
c
               t2 = x - x2
c
               t21 = ( x3 - x1 ) * ( x2 - x1 )
               t32 = ( x3 - x1 ) * ( x3 - x2 )
c
               f21(i) = t2 * ( x3 - x ) / t21
               f32(i) = t2 * ( x - x1 ) / t32
c
               g21(i) = ( ( x3 - x ) - t2 ) / t21
               g32(i) = ( ( x - x1 ) + t2 ) / t32
c
            endif
c
         endif
c						! 2-point interp/extrap:
      else
c
         f21(i) = ( x - x1 ) / ( x2 - x1 )
         g21(i) = 1.0 / ( x2 - x1 )
c
      endif
c
      return
      end
c
c************************************************************************
c
      subroutine qderNget( i, nmore, y1, y2, y3, y4, y, dydx )
c     --------------------------------------------------------
c
      common /cNquad_opal_z/ f21(30), f32(30), f43(30),
     $     g21(30), g32(30), g43(30)
      save /cNquad_opal_z/
c				! 4-point interpolation:
      if ( nmore .eq. 3 ) then
c
         y21 = y2 - y1
         y32 = y3 - y2
         y43 = y4 - y3
         y = f21(i) * y21 + f32(i) * y32 + f43(i) * y43 + y2
         dydx = g21(i) * y21 + g32(i) * y32 + g43(i) * y43
c							   ! 3-pt interp/extrap
      else if ( nmore .eq. 2 ) then
c
         y21 = y2 - y1
         y32 = y3 - y2
         y = f21(i) * y21 + f32(i) * y32 + y2
         dydx = g21(i) * y21 + g32(i) * y32
c						! 2-point interp/extrap:
      else
c
         y21 = y2 - y1
         y = f21(i) * y21 + y1
         dydx = g21(i) * y21
c
      endif
c
      return
      end
c
c************************************************************************
c
      subroutine quadNsto( i, nmore, x, x1, x2, x3, x4 )
c     --------------------------------------------------
c
      common /cNquad_opal_z/ f21(30), f32(30), f43(30),
     $     g21(30), g32(30), g43(30)
      save /cNquad_opal_z/
c				! 4-point interpolation:
      if ( nmore .eq. 3 ) then
c
         t2 = x - x2
c
         a = t2 / ( x3 - x1 )
         a21 = a * ( x3 - x ) / ( x2 - x1 )
         a32x32 = a * ( x - x1 )
c
         fhi = t2 / ( x3 - x2 )
c
         b = ( x - x3 ) / ( x4 - x2 )
         b32x32 = b * ( x4 - x )
         b43 = b * t2 / ( x4 - x3 )
c
         f21(i) = ( 1.0 - fhi ) * a21
         f43(i) = fhi * b43
c
         f32(i) = ( t2 + ( b32x32 - a32x32 ) * fhi + a32x32 )
     $        / ( x3 - x2 )
c						! 3-point interp, or extrap:
      else if ( nmore .eq. 2 ) then
c
         fhi = ( x - x3 ) / ( x3 - x2 )
c
         if ( fhi .ge. 1.0 ) then
c
            f21(i) = 0.0
            f32(i) = fhi + 1.0
c
         else if ( fhi .gt. 0.0 ) then
c
            tmp = ( fhi - 1.0 ) * ( fhi - 1.0 )
     $           * ( x - x3 ) / ( x3 - x1 )
            f21(i) = tmp * ( x2 - x3 ) / ( x2 - x1 )
            f32(i) = fhi + 1.0 + tmp
c
         else
c
            flo = ( x - x1 ) / ( x2 - x1 )
c
            if ( flo .le. -1.0 ) then
c
               f21(i) = flo - 1.0
               f32(i) = 0.0
c
            else if ( flo .lt. 0.0 ) then
c
               tmp = ( flo + 1.0 ) * ( flo + 1.0 )
     $              * ( x - x1 ) / ( x3 - x1 )
               f21(i) = flo - 1.0 + tmp
               f32(i) = tmp * ( x1 - x2 ) / ( x3 - x2 )
c
            else
c
               tmp = ( x - x2 ) / ( x3 - x1 )
               f21(i) = tmp * ( x3 - x ) / ( x2 - x1 )
               f32(i) = tmp * ( x - x1 ) / ( x3 - x2 )
c
            endif
c
         endif
c						! 2-point interp/extrap:
      else
c
         f21(i) = ( x - x1 ) / ( x2 - x1 )
c
      endif
c
      return
      end
c
c************************************************************************
c
      function quadNget( i, nmore, y1, y2, y3, y4 )
c     ---------------------------------------------
c
      common /cNquad_opal_z/ f21(30), f32(30), f43(30),
     $     g21(30), g32(30), g43(30)
      save /cNquad_opal_z/
c				! 4-point interpolation:
      if ( nmore .eq. 3 ) then
c
         quadNget = f21(i) * ( y2 - y1 ) + f32(i) * ( y3 - y2 )
     $        + f43(i) * ( y4 - y3 ) + y2
c						! 3-point interp, or extrap:
      else if ( nmore .eq. 2 ) then
c
         quadNget = f21(i) * ( y2 - y1 ) + f32(i) * ( y3 - y2 ) + y2
c
      else
c						! 2-point interp/extrap:
         quadNget = f21(i) * ( y2 - y1 ) + y1
c
      endif
c
      return
      end
c
c************************************************************************
c
      subroutine qder4sto( i, x, x1, x2, x3, x4 )
c     -------------------------------------------
c
c  This uses the same formulae as QUAD4STO below, but also takes derivatives.
c
c  Storage for x,dx_i values that need not be computed on each QDER4GET call;
c  NOTE that this same storage is used by QUAD4GET as well.
c
      common /c4quad_opal_z/ f21(30), f32(30), f43(30),
     $     g21(30), g32(30), g43(30)
      save /c4quad_opal_z/
c
      t2 = x - x2
c
      t21 = ( x3 - x1 ) * ( x2 - x1 )
      t32 = ( x3 - x1 ) * ( x3 - x2 )
c
      a21 = t2 * ( x3 - x ) / t21
      a32 = t2 * ( x - x1 ) / t32
      d21 = ( ( x3 - x ) - t2 ) / t21
      d32 = ( t2 + ( x - x1 ) ) / t32
c
      xinv32 = 1.0 / ( x3 - x2 )
c
      fhi = t2 * xinv32
      flo = 1.0 - fhi
c
      t3 = x - x3
c
      u32 = ( x4 - x2 ) * ( x3 - x2 )
      u43 = ( x4 - x2 ) * ( x4 - x3 )
c
      b32 = t3 * ( x4 - x ) / u32
      b43 = t3 * ( x - x2 ) / u43
      e32 = ( ( x4 - x ) - t3 ) / u32
      e43 = ( ( x - x2 ) + t3 ) / u43
c
      f21(i) = flo * a21
      f43(i) = fhi * b43
c
      f32(i) = fhi + ( b32 - a32 ) * fhi + a32
c
      g21(i) = flo * d21 - a21 * xinv32
      g43(i) = fhi * e43 + b43 * xinv32
c
      g32(i) = ( 1.0 + b32 - a32 ) * xinv32 + ( e32 - d32 ) * fhi + d32
c
      return
      end
c
c************************************************************************
c
      subroutine qder4get( i, y1, y2, y3, y4, y, dydx )
c     -------------------------------------------------
c
c..... this function performs a quadratic interpolation on values stored by
c      QDER4STO; it is identical to the function QUAD4GET, except that it also
c      computes the derivative dydx of the quadratic at the given position x.
c
      common /c4quad_opal_z/ f21(30), f32(30), f43(30),
     $     g21(30), g32(30), g43(30)
      save /c4quad_opal_z/
c
      y21 = y2 - y1
      y32 = y3 - y2
      y43 = y4 - y3
c
      y = f21(i) * y21 + f32(i) * y32 + f43(i) * y43 + y2
c
      dydx = g21(i) * y21 + g32(i) * y32 + g43(i) * y43
c
      return
      end
c
c************************************************************************
c
      subroutine quad4sto( i, x, x1, x2, x3, x4 )
c     -------------------------------------------
c
c  Storage for x,dx_i values that need not be computed on each QUAD4GET call;
c  NOTE that this same storage is used by QDER4GET as well.
c
c            x - x2  / x3 - x                 x - x1             \
c  L = y2 + ------- (  ------- ( y2 - y1 ) + ------- ( y3 - y2 )  )
c           x3 - x1  \ x2 - x1               x3 - x2             /
c
c            x - x3  / x4 - x                 x - x2             \
c  H = y3 + ------- (  ------- ( y3 - y2 ) + ------- ( y4 - y3 )  )
c           x4 - x2  \ x3 - x3               x4 - x3             /
c
c  equivalent            x - x2  / x4 - x                 x - x3             \
c  equivalent  H = y2 + ------- (  ------- ( y3 - y2 ) + ------- ( y4 - y2 )  )
c  equivalent           x4 - x3  \ x3 - x2               x4 - x2             /
c
c      x3 - x       x - x2
c  y = ------- L + ------- H
c      x3 - x2     x3 - x2
c
      common /c4quad_opal_z/ f21(30), f32(30), f43(30),
     $     g21(30), g32(30), g43(30)
      save /c4quad_opal_z/
c
      t2 = x - x2
c
      a = t2 / ( x3 - x1 )
      a21 = a * ( x3 - x ) / ( x2 - x1 )
      a32x32 = a * ( x - x1 )
c
      fhi = t2 / ( x3 - x2 )
c
      b = ( x - x3 ) / ( x4 - x2 )
      b32x32 = b * ( x4 - x )
      b43 = b * t2 / ( x4 - x3 )
c
      f21(i) = ( 1.0 - fhi ) * a21
      f43(i) = fhi * b43
c
      f32(i) = ( t2 + ( b32x32 - a32x32 ) * fhi + a32x32 )
     $     / ( x3 - x2 )
c
      return
      end
c
c************************************************************************
c
      function quad4get( i, y1, y2, y3, y4 )
c     --------------------------------------
c
c this function performs a quadratic interpolation on values stored by QUADSTO.
c
      common /c4quad_opal_z/ f21(30), f32(30), f43(30),
     $     g21(30), g32(30), g43(30)
      save /c4quad_opal_z/
c
      quad4get = f21(i) * ( y2 - y1 ) + f32(i) * ( y3 - y2 )
     $     + f43(i) * ( y4 - y3 ) + y2
c
      return
      end
c
c************************************************************************
c
      subroutine qdersto( i, x, x1, x2, x3 )
c     --------------------------------------
c
c  Storage for x,dx_i values that need not be computed on each QDERGET call;
c  NOTE that this same storage is used by all of QUAD, QDER, and QCHK.
c
c            x - x2  / x3 - x                 x - x1             \
c  y = y2 + ------- (  ------- ( y2 - y1 ) + ------- ( y3 - y2 )  )
c           x3 - x1  \ x2 - x1               x3 - x2             /
c
c    = y2 + a21(i) * ( y2 - y1 ) + a32(i) * ( y3 - y2 )
c
c  dy    ( x3 - x ) - ( x - x2 )             ( x - x1 ) + ( x - x2 )
c  -- = ------------------------- (y2-y1) + ------------------------- (y3-y2)
c  dx   ( x3 - x1 ) * ( x2 - x1 )           ( x3 - x1 ) * ( x2 - x1 )
c
c     = d21(i)  * ( y2 - y1 ) + d32(i) * ( y3 - y2 )
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c
      t2 = x - x2
      t21 = ( x3 - x1 ) * ( x2 - x1 )
      t32 = ( x3 - x1 ) * ( x3 - x2 )
c
      a21(i) = t2 * ( x3 - x ) / t21
      a32(i) = t2 * ( x - x1 ) / t32
      d21(i) = ( ( x3 - x ) - t2 ) / t21
      d32(i) = ( ( x - x1 ) + t2 ) / t32
c
      return
      end
c
c************************************************************************
c
      subroutine qderget( i, y1, y2, y3, y, dydx )
c     --------------------------------------------
c
c..... this function performs a quadratic interpolation on values stored by
c      QDERSTO; it is identical to the function QUADGET, except that it also
c      computes the derivative dydx of the quadratic at the given position x.
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c
      y21 = y2 - y1
      y32 = y3 - y2
c
      dydx = d21(i) * y21 + d32(i) * y32
      y = a21(i) * y21 + a32(i) * y32 + y2
c
      return
      end
c
c************************************************************************
c
      subroutine quadsto( i, x, x1, x2, x3 )
c     --------------------------------------
c
c  Storage for x,dx_i values that need not be computed on each QUADGET call;
c  NOTE that this same storage is used by all of QUAD, QDER, and QCHK.
c
c            x - x2  / x3 - x                 x - x1             \
c  y = y2 + ------- (  ------- ( y2 - y1 ) + ------- ( y3 - y2 )  )
c           x3 - x1  \ x2 - x1               x3 - x2             /
c
c    = y2 + a21(i) * ( y2 - y1 ) + a32(i) * ( y3 - y2 )
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c
      tmp = ( x - x2 ) / ( x3 - x1 )
      a21(i) = tmp * ( x3 - x ) / ( x2 - x1 )
      a32(i) = tmp * ( x - x1 ) / ( x3 - x2 )
c
      return
      end
c
c************************************************************************
c
      function quadget( i, y1, y2, y3 )
c     ---------------------------------
c
c this function performs a quadratic interpolation on values stored by QUADSTO.
c
      common /c3quad_opal_z/ a21(30), a32(30), d21(30), d32(30)
      save /c3quad_opal_z/
c
      quadget = a21(i) * ( y2 - y1 ) + a32(i) * ( y3 - y2 ) + y2
c
      return
      end
c
c************************************************************************
c
      function num_blanks_contained( fname )
c     ======================================
c
c  Count the number of blanks between first and last non-blank characters
c
      character*(*) fname
c
      character*1 ctab
      common /c_ctab/ ctab
      save /c_ctab/
c
      iblank = 0
c
      if ( lnblnk(fname) .gt. 0 ) then
c
         do i = non_blank_begin(fname), lnblnk(fname)
            if ( fname(i:i) .eq. ' ' .or. fname(i:i) .eq. ctab )
     $           iblank = iblank + 1
         enddo
c
      endif
c
      num_blanks_contained = iblank
c
      return
      end
c
c************************************************************************
c
      function non_blank_begin( fname )
c     =================================
c
c  Find the first non-blank character in the input character variable
c
      character*(*) fname
c
      character*1 ctab
      common /c_ctab/ ctab
      save /c_ctab/
c
      last = lnblnk( fname )
c
      if ( last .le. 1 ) then
         i = last
      else
         i = 1
         do while ( i .lt. last .and.
     $        ( fname(i:i) .eq. ' ' .or. fname(i:i) .eq. ctab ) )
            i = i + 1
         enddo
      endif
c
      non_blank_begin = i
c
      return
      end
c
c************************************************************************
c  NOTE that the subroutines below have alternate parts, all but one
c  commented out, for various flavors of UNIX and for VMS (the Linux
c  versions should actually work for any flavor of UNIX).
c***********************************************************************
c
      subroutine opoldr(iu,fname)
c     ===========================
c
c Open an old formatted file:
c
      character*(*) fname
c
      character*1 cb(6)
      common /chkpoc/ cb
      save /chkpoc/
c
c-linux[
      character*255 fnalt
c-linux]
c
c  For Linux: get home directory name if necessary, and open the file
c  with the err= keyword to prevent coredump
c  (actually, this should work on any Unix system, provided that the
c  environment variable HOME is correctly defined as the home directory):
c-linux[
      call linux_get_home_dir(fname,fnalt,ialt)
c
      if ( ialt .gt. 0 ) then
         open(iu,file=fnalt,form='FORMATTED',status='OLD',
     $        iostat=ioperr,err=900)
      else
         open(iu,file=fname,form='FORMATTED',status='OLD',
     $        iostat=ioperr,err=900)
      endif
c
      return
c
 900  write(6,910) ioperr,iu,fname(:lnblnk(fname))
 910  format(' '/' Error',i12,' opening unit',i3,' with old file:'/
     $     ' ',a)
      stop ' STOP -- OPOLDR: Error opening old file. '
c-linux]
c
c  For Sun UNIX: open the file:
c-sun[
c-sun;      open(iu,file=fname,form='FORMATTED',status='OLD')
c-sun;      return
c-sun]
c
c  For VMS, or for Iris UNIX: open the file as read-only:
c-vms-iris[
c-vms-iris;      open(iu,file=fname,form='FORMATTED',status='OLD',
c-vms-iris;     $     readonly)
c-vms-iris;      return
c-vms-iris]
c
      end
c
c************************************************************************
c
      subroutine opoluf(iu,fname)
c     ===========================
c
c Open an old unformatted file:
c
      character*(*) fname
c
c  For Linux: open the file, with the err= keyword to prevent coredump:
c-linux[
      character*255 fnalt
c
      call linux_get_home_dir(fname,fnalt,ialt)
c
      if ( ialt .gt. 0 ) then
         open(iu,file=fnalt,form='UNFORMATTED',status='OLD',
     $        iostat=ioperr,err=900)
      else
         open(iu,file=fname,form='UNFORMATTED',status='OLD',
     $        iostat=ioperr,err=900)
      endif
c
      return
c
 900  write(6,910) ioperr,iu,fname(:lnblnk(fname))
 910  format(' '/' Error',i12,' opening unit',i3,
     $     ' with old unformatted file:'/' ',a)
      stop ' STOP -- OPOLUF: Error opening old unformatted file. '
c-linux]
c
c  For Sun UNIX: open the file:
c-sun[
c-sun;      open(iu,file=fname,form='UNFORMATTED',status='OLD')
c-sun;      return
c-sun]
c
c  For VMS or Iris UNIX: open the file as read-only:
c-vms-iris[
c-vms-iris;      open(iu,file=fname,form='UNFORMATTED',status='OLD',
c-vms-iris;     $     readonly)
c-vms-iris;      return
c-vms-iris]
c
      end
c
c************************************************************************
c
      subroutine opneuf(iu,fname)
c     ===========================
c
c Open a new unformatted file:
c
      character*(*) fname
c
c  For Linux: open the file, with the err= keyword to prevent coredump:
c-linux[
      character*255 fnalt
c
      call linux_get_home_dir(fname,fnalt,ialt)
c
      if ( ialt .gt. 0 ) then
         open(iu,file=fnalt,form='UNFORMATTED',status='UNKNOWN',
     $        iostat=ioperr,err=900)
      else
         open(iu,file=fname,form='UNFORMATTED',status='UNKNOWN',
     $        iostat=ioperr,err=900)
      endif
c
      return
c
 900  write(6,910) ioperr,iu,fname(:lnblnk(fname))
 910  format(' '/' Error',i12,' opening unit',i3,
     $     ' with new unformatted file:'/' ',a)
      stop ' STOP -- OPNEUF: Error opening new unformatted file. '
c-linux]
c
c  For UNIX: open the file status UNKNOWN so not an error if file exists:
c-sun-iris[
c-sun-iris;      open(iu,file=fname,form='UNFORMATTED',status='UNKNOWN')
c-sun-iris;      return
c-sun-iris]
c
c  For VMS: open the file status NEW:
c-vms[
c-vms;      open(iu,file=fname,form='UNFORMATTED',status='NEW')
c-vms;      return
c-vms]
c
      end
c
c************************************************************************
c
      subroutine inqfil(fname,lxst)
c     =============================
c
      character*(*) fname
      logical lxst
c
c  For Linux: get home directory name, if necessary
c  (actually, this should work on any Unix system, provided that the
c  environment variable HOME is correctly defined as the home directory):
c-linux[
      character*255 fnalt
c
      call linux_get_home_dir(fname,fnalt,ialt)
c
      if ( ialt .gt. 0 ) then
         inquire( file = fnalt, exist = lxst )
      else
         inquire( file = fname, exist = lxst )
      endif
c-linux]
c
c  Anything else: just look for filename as is:
c-sun-vms-iris[
c-sun-vms-iris;      inquire( file = fname , exist = lxst )
c-sun-vms-iris]
c
      return
      end
c
c************************************************************************
c
c-linux[
      subroutine linux_get_home_dir(fname,fnalt,ialt)
c     ===============================================
c
c  For Linux, at least with fort77, the prefix '~' in a filename is not
c  recognized as "home directory": get it from HOME environment variable.
c  (Actually, this should work on any Unix system, provided that the
c  environment variable HOME is correctly defined as the home directory.)
c
      character*(*) fname
      character*(*) fnalt
c
      if ( len(fname) .ge. 2 .and. fname(1:2) .eq. '~/' ) then
c
         ialt = 1
         call getenv( 'HOME' , fnalt )
         i = lnblnk(fnalt)
         if ( lnblnk(fname) + i - 1 .gt. len(fnalt) ) then
            write(6,900) lnblnk(fname) + i - 1, len(fnalt),
     $           fnalt(1:i), fname(2:lnblnk(fname))
 900        format(' '/' Error: filename has',i6,
     $           ' characters >',i6,' --- too long:'/' ',a,a)
            stop ' STOP -- LINUX_GET_HOME_DIR: filename too long. '
         endif
         fnalt(i+1:) = fname(2:)
c
      else
c
         ialt = 0
c
      endif
c
      return
      end
c-linux]
c
c************************************************************************
c
c-linux[
      function lnblnk(fname)
c     ======================
c
c  Needed for fort77 under Linux, since fort77 linker can't find  lnblnk_
c
      character*(*) fname
c
      character*1 ctab
      common /c_ctab/ ctab
      save /c_ctab/
c
      i = len(fname)
c
      do while( i .gt. 1 .and.
     $     ( fname(i:i) .eq. ' ' .or. fname(i:i) .eq. ctab ) )
         i = i - 1
      enddo
      if ( fname(i:i) .eq. ' ' .or. fname(i:i) .eq. ctab ) i = i - 1
c
      lnblnk = i
c
      return
      end
c-linux]
c
c************************************************************************
c
