Title: 				atomscat
Keywords:		 		High Energy Electron Diffraction, Absorption
Computer: 			Any with F77 compiler
Operating System: 		Any
Programming Language: 	Standard Fortran 77
Hardware Requirements: 	none
Author(s): 			Q. A. King and D. M. Bird
Correspondence Address: 	School of Physics, University of Bath, 
					Bath BA2 7AY, UK.
Email: d.bird@gdr.bath.ac.uk (Internet)

Abstract:
Atom is a subroutine which when passed the name of an element,  the 
length of a g-vector and a Debye-Waller factor will compute and return
 both the real and absorptive atomic scattering factors, which can then
 be incorporated into any existing diffraction program. All the data is
 self-contained within the subroutine, documentation may be found at the
 head of the subroutine.  
  
Title: 				atomscat
Keywords:		 		High Energy Electron Diffraction, Absorption
Computer: 			Any with F77 compiler
Operating System: 		Any
Programming Language: 	Standard Fortran 77
Hardware Requirements: 	none
Author(s): 			Q. A. King and D. M. Bird
Correspondence Address: 	School of Physics, University of Bath, 
					Bath BA2 7AY, UK.
Email: d.bird@gdr.bath.ac.uk (Internet)

  
C ----------------------------------------------------------------------
C ----------------  ATOM - Atomic Form Factors Subroutine  -------------
C ----------------------------------------------------------------------
C -----  Author: Quentin King, School of Physics, Bath University  -----
C
C   This program is made freely available to all in the electron
C   diffraction community. We would ask that users make reference
C   to the paper that describes the background to this subroutine:
C      D.M. Bird and Q.A. King, Acta Cryst. A??, ????-????, (1989).
C ----------------------------------------------------------------------
C
C       CALL ATOM( ELNAME, M, S, KVOLTS, FE, FA, STATUS )
C
C In:ELNAME - CH*2 - Element name (upper case only)
C         M - D.P. - 8.(pi^2).u^2; u^2 = mean square atomic vibration
C         S - D.P. - Scattering vector (as in Doyle and Turner)
C    KVOLTS - D.P. - Accelerating voltage in KVolts
C    STATUS - INT. - Error control
C
C Out:   FE - D.P. - Elastic part of atomic form factor * exp(-Ms^2)
C        FA - D.P. - Imag part of form factor (inc. 1/beta) * exp(-Ms^2)
C    STATUS - INT. - Returned status
C
C Note: If Ms^2 > 6.0 or s > 6.0 both FE and FA return 0.0D0
C       If M < 0.05 then FA returns 0.0D0
C
C ELNAME: Element name, in upper case, left justified,
C          e.g. 'GA', 'AS', 'S ', 'P '
C
C KVOLTS: Accelerating voltage in KeV.
C         If KVOLTS = 0.0D0, BETA is taken as 1.
C
C STATUS: If STATUS is passed with a negative value, then should an
C         error occur, the subroutine will write the relevent error
C         message to unit -STATUS and execution will be terminated.
C         If STATUS is positive, a code number is returned in STATUS
C         and even if an error has occured, execution will not be
C         terminated. The codes are:
C
C             0 - Successful
C             1 - Unknown element
C             2 - M out of range (M < 0 or M > 2)
C             3 - S less than zero
C             4 - KVOLTS out of range (KVOLTS < 0.0 or KVOLTS > 10.^4)
C

Title: 				atomscat
Keywords:		 		High Energy Electron Diffraction, Absorption
Computer: 			Any with F77 compiler
Operating System: 		Any
Programming Language: 	Standard Fortran 77
Hardware Requirements: 	none
Author(s): 			Q. A. King and D. M. Bird
Correspondence Address: 	School of Physics, University of Bath, 
					Bath BA2 7AY, UK.
Email: d.bird@gdr.bath.ac.uk (Internet)

  
C ----------------------------------------------------------------------
C ----------------  ATOM - Atomic Form Factors Subroutine  -------------
C ----------------------------------------------------------------------
C -----  Author: Quentin King, School of Physics, Bath University  -----
C
C   This program is made freely available to all in the electron
C   diffraction community. We would ask that users make reference
C   to the paper that describes the background to this subroutine:
C      D.M. Bird and Q.A. King, Acta Cryst. A??, ????-????, (1989).
C ----------------------------------------------------------------------
C
C       CALL ATOM( ELNAME, M, S, KVOLTS, FE, FA, STATUS )
C
C In:ELNAME - CH*2 - Element name (upper case only)
C         M - D.P. - 8.(pi^2).u^2; u^2 = mean square atomic vibration
C         S - D.P. - Scattering vector (as in Doyle and Turner)
C    KVOLTS - D.P. - Accelerating voltage in KVolts
C    STATUS - INT. - Error control
C
C Out:   FE - D.P. - Elastic part of atomic form factor * exp(-Ms^2)
C        FA - D.P. - Imag part of form factor (inc. 1/beta) * exp(-Ms^2)
C    STATUS - INT. - Returned status
C
C Note: If Ms^2 > 6.0 or s > 6.0 both FE and FA return 0.0D0
C       If M < 0.05 then FA returns 0.0D0
C
C ELNAME: Element name, in upper case, left justified,
C          e.g. 'GA', 'AS', 'S ', 'P '
C
C KVOLTS: Accelerating voltage in KeV.
C         If KVOLTS = 0.0D0, BETA is taken as 1.
C
C STATUS: If STATUS is passed with a negative value, then should an
C         error occur, the subroutine will write the relevent error
C         message to unit -STATUS and execution will be terminated.
C         If STATUS is positive, a code number is returned in STATUS
C         and even if an error has occured, execution will not be
C         terminated. The codes are:
C
C             0 - Successful
C             1 - Unknown element
C             2 - M out of range (M < 0 or M > 2)
C             3 - S less than zero
C             4 - KVOLTS out of range (KVOLTS < 0.0 or KVOLTS > 10.^4)
C
C ----------------------------------------------------------------------
        SUBROUTINE ATOM( ELNAME, M, S, KVOLTS, FE, FA, STATUS )
C ----------------------------------------------------------------------
C
        INTEGER IN, JN, DTN
        PARAMETER ( IN     =     6,
     +              JN     =    10,
     +              DTN    =    27 )
C
        DOUBLE PRECISION GM( IN ), GMS2( JN )
C
        INTEGER NUMELS
        CHARACTER*162 ELNAMS
C
        PARAMETER ( NUMELS = 54,
     +              ELNAMS = 'HE LI BE B  C  N  O  F  NE NA MG AL '
     +                     //'SI P  S  CL AR K  CA SC TI V  CR MN '
     +                     //'FE CO NI CU ZN GA GE AS SE BR KR RB '
     +                     //'SR MO AG CD IN SN SB I  XE CS BA EU '
     +                     //'AU HG PB BI RN U  ')
C
        INTEGER STATUS, ISTAT, I, I0, I1, J, J0, J1, ELNUM
        INTEGER DT( DTN, NUMELS ), MLTFCT( NUMELS ), ADDFCT( NUMELS )
        INTEGER COUNT, BFLAG, RFLAG, LFLAG
C
        REAL RF( 4 ), QF( 4, 5 ), FATM( 4 ), F( IN, JN, NUMELS )
        REAL RMLT, RADD, EXP, EXPMS2
C
        DOUBLE PRECISION M, S, KVOLTS, FE, FA, DWF, DTS( DTN )
        DOUBLE PRECISION MS2, BETA, BIQINT, CINT, DEXP, SQRT
C
        CHARACTER*2  ELNAME
        CHARACTER*20 ERRMSG( 4 )
C
        DATA GM  / 0.05, 0.15, 0.30, 0.70, 1.30, 2.00/
        DATA GMS2/ 0.00, 0.005, 0.025, 0.07, 0.20,
     +             0.50, 1.20, 2.00, 3.50, 6.00/
C
        SAVE
C
        DATA ERRMSG / 'Unknown element.    ',
     +                'M out of range.     ',
     +                'S less than zero.   ',
     +                'KVOLTS out of range.' /
C
        DATA DTS / 0.00, 0.05, 0.10, 0.15, 0.20, 0.25, 0.30, 0.35, 0.40,
     +             0.45, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00, 1.20, 1.40,
     +             1.60, 1.80, 2.00, 2.50, 3.00, 3.50, 4.00, 5.00, 6.00/
C
C ----------------------------------------------------------------------
C
C
C ----- HE -----
C
      DATA MLTFCT( 1),ADDFCT( 1),(DT(I, 1),I=1,DTN)/1832615,00989,
     +00418,00410,00390,00359,00323,00286,00250,00217,00189,
     +00164,00143,00110,00086,00068,00055,00046,00032,00024,
     +00019,00015,00012,00008,00005,00004,00003,00002,00001/
      DATA ((F(I,J, 1),I=1,IN),J=1,JN)/
     +247.,330.,420.,582.,737.,859.,289.,360.,443.,596.,747.,866.,423.,
     +468.,527.,651.,781.,886.,632.,646.,678.,756.,847.,928.,874.,907.,
     +916.,933.,963.,999.,912.,905.,956.,967.,966.,972.,409.,429.,478.,
     +546.,581.,608.,82.1,108.,127.,193.,244.,280.,1.22,.000,15.1,43.2,
     +74.4,94.5,116.,115.,113.,117.,127.,134./
C
C ----- LI -----
C
      DATA MLTFCT( 2),ADDFCT( 2),(DT(I, 2),I=1,DTN)/1273228,01481,
     +03286,02800,01879,01166,00753,00526,00396,00314,00259,
     +00219,00188,00145,00115,00093,00077,00064,00046,00035,
     +00028,00022,00017,00011,00008,00006,00004,00003,00002/
      DATA ((F(I,J, 2),I=1,IN),J=1,JN)/
     +201.,217.,235.,268.,303.,333.,288.,288.,289.,305.,330.,354.,449.,
     +484.,488.,463.,446.,444.,651.,684.,713.,712.,672.,634.,937.,930.,
     +949.,977.,966.,934.,882.,913.,967.,989.,999.,998.,507.,471.,501.,
     +567.,598.,616.,117.,113.,162.,211.,266.,292.,.000,19.8,34.9,48.6,
     +92.4,112.,121.,129.,115.,131.,134.,145./
C
C ----- BE -----
C
      DATA MLTFCT( 3),ADDFCT( 3),(DT(I, 3),I=1,DTN)/0967722,01920,
     +03052,02807,02237,01635,01161,00832,00614,00469,00371,
     +00302,00253,00186,00145,00117,00096,00081,00059,00045,
     +00035,00028,00023,00015,00011,00008,00006,00004,00003/
      DATA ((F(I,J, 3),I=1,IN),J=1,JN)/
     +204.,227.,253.,303.,358.,406.,273.,275.,290.,329.,376.,421.,459.,
     +457.,440.,433.,451.,480.,672.,696.,685.,638.,608.,602.,942.,957.,
     +967.,944.,890.,843.,906.,987.,992.,999.,982.,946.,429.,503.,544.,
     +574.,593.,595.,95.6,135.,189.,230.,262.,279.,.000,5.43,39.6,68.1,
     +91.5,108.,116.,116.,120.,133.,137.,142./
C
C ----- B  -----
C
      DATA MLTFCT( 4),ADDFCT( 4),(DT(I, 4),I=1,DTN)/0787931,02428,
     +02794,02638,02250,01791,01377,01048,00803,00625,00497,
     +00402,00333,00239,00182,00144,00118,00098,00072,00055,
     +00043,00035,00028,00019,00013,00010,00007,00005,00003/
      DATA ((F(I,J, 4),I=1,IN),J=1,JN)/
     +216.,248.,284.,353.,428.,494.,275.,289.,316.,375.,444.,507.,460.,
     +446.,440.,462.,508.,556.,684.,690.,665.,632.,634.,654.,957.,971.,
     +970.,918.,868.,844.,943.,979.,999.,997.,962.,925.,494.,502.,549.,
     +575.,587.,583.,117.,138.,190.,232.,258.,269.,.000,20.0,44.6,71.0,
     +93.9,107.,121.,128.,121.,136.,141.,147./
C
C ----- C  -----
C
      DATA MLTFCT( 5),ADDFCT( 5),(DT(I, 5),I=1,DTN)/0653425,02832,
     +02509,02406,02138,01796,01460,01168,00932,00748,00606,
     +00497,00413,00297,00223,00175,00141,00117,00085,00064,
     +00051,00041,00034,00022,00016,00012,00009,00006,00004/
      DATA ((F(I,J, 5),I=1,IN),J=1,JN)/
     +218.,259.,305.,393.,486.,568.,269.,296.,334.,413.,501.,579.,447.,
     +434.,443.,489.,556.,621.,680.,668.,642.,635.,662.,702.,947.,963.,
     +943.,888.,858.,852.,932.,995.,999.,970.,931.,906.,444.,520.,545.,
     +567.,568.,565.,101.,148.,193.,228.,245.,255.,.000,10.7,45.9,69.7,
     +87.5,96.2,115.,116.,121.,132.,137.,140./
C
C ----- N  -----
C
      DATA MLTFCT( 6),ADDFCT( 6),(DT(I, 6),I=1,DTN)/0575485,03181,
     +02211,02144,01963,01718,01458,01216,01006,00831,00689,
     +00575,00484,00353,00266,00208,00167,00137,00098,00074,
     +00058,00047,00039,00026,00018,00013,00010,00007,00005/
      DATA ((F(I,J, 6),I=1,IN),J=1,JN)/
     +226.,279.,339.,451.,567.,665.,273.,314.,365.,469.,580.,675.,440.,
     +440.,465.,538.,628.,709.,681.,660.,647.,667.,720.,777.,951.,965.,
     +934.,895.,887.,898.,955.,997.,999.,965.,938.,926.,472.,496.,543.,
     +561.,566.,573.,114.,141.,180.,220.,237.,253.,.000,16.5,29.1,64.9,
     +78.8,89.3,113.,117.,119.,128.,134.,136./
C
C ----- O  -----
C
      DATA MLTFCT( 7),ADDFCT( 7),(DT(I, 7),I=1,DTN)/0507865,03564,
     +01983,01937,01808,01625,01422,01222,01040,00881,00747,
     +00635,00542,00403,00307,00241,00193,00159,00113,00085,
     +00066,00053,00044,00029,00020,00015,00012,00008,00005/
      DATA ((F(I,J, 7),I=1,IN),J=1,JN)/
     +234.,300.,372.,506.,641.,752.,279.,333.,397.,523.,652.,759.,437.,
     +450.,490.,585.,694.,788.,674.,657.,657.,702.,773.,843.,958.,954.,
     +929.,907.,916.,939.,992.,999.,989.,967.,949.,942.,454.,515.,537.,
     +556.,573.,587.,109.,158.,178.,213.,238.,262.,.000,13.7,34.0,59.0,
     +74.2,89.3,110.,111.,120.,124.,130.,133./
C
C ----- F  -----
C
      DATA MLTFCT( 8),ADDFCT( 8),(DT(I, 8),I=1,DTN)/0456837,04056,
     +01801,01767,01671,01532,01371,01206,01049,00908,00784,
     +00677,00586,00445,00344,00272,00219,00180,00128,00095,
     +00074,00060,00049,00032,00023,00017,00013,00009,00006/
      DATA ((F(I,J, 8),I=1,IN),J=1,JN)/
     +250.,329.,414.,569.,719.,839.,293.,360.,437.,584.,729.,846.,443.,
     +471.,524.,640.,765.,869.,678.,666.,680.,746.,833.,913.,973.,956.,
     +936.,931.,954.,987.,980.,999.,996.,977.,969.,968.,483.,525.,544.,
     +567.,590.,609.,118.,156.,188.,219.,251.,282.,.000,19.3,39.5,60.2,
     +80.3,98.4,114.,118.,122.,130.,133.,138./
C
C ----- NE -----
C
      DATA MLTFCT( 9),ADDFCT( 9),(DT(I, 9),I=1,DTN)/0402885,04463,
     +01652,01626,01552,01443,01313,01176,01043,00918,00805,
     +00706,00619,00479,00376,00300,00244,00201,00143,00106,
     +00083,00066,00054,00036,00025,00019,00015,00009,00007/
      DATA ((F(I,J, 9),I=1,IN),J=1,JN)/
     +255.,344.,439.,607.,767.,890.,295.,373.,461.,621.,775.,895.,436.,
     +476.,540.,671.,805.,914.,661.,658.,682.,764.,863.,947.,962.,935.,
     +920.,927.,961.,999.,986.,991.,976.,962.,959.,960.,455.,521.,540.,
     +563.,590.,610.,110.,162.,186.,219.,258.,291.,.000,15.5,40.0,61.0,
     +82.7,103.,110.,112.,120.,125.,130.,135./
C
C ----- NA -----
C
      DATA MLTFCT(10),ADDFCT(10),(DT(I,10),I=1,DTN)/0361753,04957,
     +04778,04138,02967,02099,01594,01295,01095,00946,00827,
     +00727,00642,00505,00403,00325,00266,00221,00158,00117,
     +00092,00073,00059,00039,00028,00021,00016,00010,00007/
      DATA ((F(I,J,10),I=1,IN),J=1,JN)/
     +207.,240.,275.,336.,394.,440.,298.,340.,364.,401.,441.,477.,437.,
     +487.,539.,592.,607.,613.,651.,660.,697.,770.,811.,816.,952.,919.,
     +915.,939.,976.,999.,955.,971.,964.,958.,962.,969.,468.,516.,535.,
     +563.,592.,610.,114.,157.,188.,222.,265.,298.,.000,19.4,43.1,61.4,
     +88.4,111.,110.,114.,119.,126.,130.,136./
C
C ----- MG -----
C
      DATA MLTFCT(11),ADDFCT(11),(DT(I,11),I=1,DTN)/0339037,05314,
     +05207,04717,03656,02657,01953,01502,01211,01012,00868,
     +00757,00667,00528,00425,00347,00286,00239,00172,00129,
     +00100,00080,00065,00043,00030,00022,00017,00011,00008/
      DATA ((F(I,J,11),I=1,IN),J=1,JN)/
     +208.,241.,276.,338.,397.,444.,299.,322.,340.,382.,428.,468.,449.,
     +501.,532.,543.,549.,562.,660.,683.,724.,766.,759.,740.,951.,936.,
     +940.,975.,998.,989.,973.,979.,979.,983.,993.,999.,484.,506.,539.,
     +577.,608.,625.,121.,152.,182.,230.,276.,308.,.000,21.6,32.9,62.5,
     +91.7,116.,110.,115.,118.,125.,131.,137./
C
C ----- AL -----
C
      DATA MLTFCT(12),ADDFCT(12),(DT(I,12),I=1,DTN)/0313151,05684,
     +05889,05371,04237,03128,02299,01737,01363,01111,00932,
     +00801,00700,00551,00445,00366,00304,00255,00185,00139,
     +00109,00087,00070,00046,00032,00024,00019,00012,00009/
      DATA ((F(I,J,12),I=1,IN),J=1,JN)/
     +205.,236.,269.,328.,384.,431.,292.,306.,324.,366.,412.,451.,453.,
     +497.,508.,506.,515.,532.,659.,690.,726.,734.,706.,686.,952.,936.,
     +946.,981.,977.,945.,991.,971.,978.,986.,999.,996.,471.,518.,538.,
     +580.,608.,624.,118.,162.,184.,232.,279.,308.,.000,19.8,36.7,61.6,
     +94.6,118.,108.,112.,119.,123.,129.,137./
C
C ----- SI -----
C
      DATA MLTFCT(13),ADDFCT(13),(DT(I,13),I=1,DTN)/0289074,06202,
     +05828,05421,04467,03437,02589,01969,01534,01231,01016,
     +00861,00743,00578,00465,00383,00320,00270,00198,00150,
     +00117,00093,00076,00050,00035,00026,00020,00013,00009/
      DATA ((F(I,J,13),I=1,IN),J=1,JN)/
     +208.,242.,277.,340.,402.,453.,288.,301.,323.,371.,424.,470.,460.,
     +490.,489.,490.,509.,534.,662.,700.,722.,703.,674.,663.,948.,941.,
     +958.,978.,946.,902.,971.,982.,980.,995.,999.,983.,481.,514.,546.,
     +584.,612.,625.,120.,157.,189.,241.,285.,311.,.000,21.5,38.5,69.5,
     +100.,123.,110.,115.,118.,125.,133.,140./
C
C ----- P  -----
C
      DATA MLTFCT(14),ADDFCT(14),(DT(I,14),I=1,DTN)/0269398,06675,
     +05488,05192,04457,03586,02796,02169,01702,01362,01115,
     +00933,00797,00610,00487,00401,00335,00284,00210,00160,
     +00125,00100,00082,00053,00037,00028,00021,00014,00010/
      DATA ((F(I,J,14),I=1,IN),J=1,JN)/
     +212.,250.,290.,361.,431.,489.,283.,300.,328.,387.,449.,503.,463.,
     +479.,475.,486.,519.,555.,663.,703.,711.,678.,659.,661.,936.,942.,
     +964.,966.,916.,870.,971.,972.,980.,999.,994.,965.,497.,516.,541.,
     +586.,614.,623.,126.,158.,189.,245.,288.,311.,.000,25.6,41.4,72.1,
     +104.,126.,111.,118.,118.,126.,135.,141./
C
C ----- S  -----
C
      DATA MLTFCT(15),ADDFCT(15),(DT(I,15),I=1,DTN)/0251227,07079,
     +05161,04938,04362,03635,02927,02326,01851,01490,01218,
     +01014,00860,00648,00513,00419,00350,00298,00221,00169,
     +00133,00107,00087,00057,00040,00030,00023,00015,00010/
      DATA ((F(I,J,15),I=1,IN),J=1,JN)/
     +214.,256.,301.,381.,459.,525.,278.,301.,334.,403.,475.,536.,462.,
     +467.,464.,489.,534.,579.,667.,700.,693.,659.,654.,668.,942.,946.,
     +967.,944.,886.,847.,967.,972.,984.,999.,978.,939.,477.,519.,548.,
     +588.,611.,616.,119.,161.,196.,248.,287.,307.,.000,21.6,42.9,74.1,
     +105.,125.,109.,114.,118.,126.,133.,140./
C
C ----- CL -----
C
      DATA MLTFCT(16),ADDFCT(16),(DT(I,16),I=1,DTN)/0238015,07396,
     +04857,04685,04227,03620,02997,02438,01974,01606,01319,
     +01098,00928,00692,00541,00440,00366,00311,00232,00178,
     +00141,00113,00093,00060,00042,00031,00024,00016,00011/
      DATA ((F(I,J,16),I=1,IN),J=1,JN)/
     +217.,264.,314.,404.,492.,565.,275.,304.,344.,423.,505.,575.,460.,
     +458.,461.,500.,557.,612.,668.,697.,680.,653.,662.,688.,929.,949.,
     +967.,928.,871.,842.,968.,970.,986.,999.,967.,923.,485.,513.,542.,
     +589.,610.,611.,123.,159.,190.,248.,286.,304.,.000,23.6,37.3,73.5,
     +104.,123.,107.,113.,116.,123.,133.,139./
C
C ----- AR -----
C
      DATA MLTFCT(17),ADDFCT(17),(DT(I,17),I=1,DTN)/0225458,07798,
     +04580,04444,04074,03566,03022,02512,02070,01705,01412,
     +01181,00998,00740,00574,00462,00383,00324,00242,00187,
     +00148,00119,00098,00064,00045,00033,00026,00017,00012/
      DATA ((F(I,J,17),I=1,IN),J=1,JN)/
     +221.,274.,330.,429.,527.,608.,275.,311.,357.,447.,539.,616.,460.,
     +454.,464.,515.,585.,648.,677.,693.,670.,653.,677.,713.,941.,962.,
     +969.,914.,863.,844.,972.,983.,996.,999.,954.,910.,472.,520.,553.,
     +593.,609.,607.,119.,163.,198.,252.,286.,302.,.000,20.6,39.6,76.6,
     +105.,122.,107.,110.,117.,124.,133.,139./
C
C ----- K  -----
C
      DATA MLTFCT(18),ADDFCT(18),(DT(I,18),I=1,DTN)/0213717,08287,
     +08984,07619,05426,03997,03154,02578,02134,01776,01487,
     +01252,01064,00790,00609,00488,00402,00339,00252,00194,
     +00156,00127,00101,00068,00047,00035,00027,00018,00012/
      DATA ((F(I,J,18),I=1,IN),J=1,JN)/
     +201.,230.,260.,313.,367.,411.,278.,310.,338.,375.,414.,449.,456.,
     +453.,470.,516.,551.,572.,679.,685.,662.,662.,689.,714.,956.,963.,
     +960.,900.,864.,857.,982.,968.,999.,990.,941.,902.,488.,519.,558.,
     +594.,605.,601.,124.,166.,202.,251.,285.,299.,.000,25.0,43.4,76.1,
     +107.,122.,108.,114.,118.,126.,133.,141./
C
C ----- CA -----
C
      DATA MLTFCT(19),ADDFCT(19),(DT(I,19),I=1,DTN)/0202344,08756,
     +09913,08703,06388,04550,03408,02695,02206,01838,01548,
     +01314,01123,00838,00647,00515,00422,00354,00262,00202,
     +00162,00132,00107,00071,00050,00037,00028,00018,00013/
      DATA ((F(I,J,19),I=1,IN),J=1,JN)/
     +200.,227.,256.,307.,358.,400.,279.,304.,321.,354.,393.,428.,451.,
     +453.,473.,501.,517.,531.,681.,675.,657.,667.,685.,691.,947.,964.,
     +949.,890.,868.,866.,966.,974.,999.,978.,928.,895.,494.,522.,557.,
     +592.,598.,592.,126.,164.,205.,253.,282.,295.,.000,26.5,45.8,79.6,
     +107.,120.,108.,115.,117.,127.,134.,141./
C
C ----- SC -----
C
      DATA MLTFCT(20),ADDFCT(20),(DT(I,20),I=1,DTN)/0192461,09141,
     +09307,08318,06328,04633,03509,02783,02281,01906,01612,
     +01374,01179,00885,00684,00544,00444,00371,00273,00211,
     +00169,00137,00112,00075,00052,00039,00030,00019,00014/
      DATA ((F(I,J,20),I=1,IN),J=1,JN)/
     +202.,231.,263.,319.,376.,422.,279.,305.,325.,364.,409.,448.,448.,
     +453.,475.,505.,525.,543.,682.,669.,655.,670.,689.,696.,949.,964.,
     +940.,885.,870.,871.,976.,983.,999.,968.,920.,893.,484.,525.,560.,
     +590.,593.,587.,123.,168.,206.,253.,280.,292.,.000,24.7,46.8,80.7,
     +106.,119.,107.,113.,117.,126.,134.,139./
C
C ----- TI -----
C
      DATA MLTFCT(21),ADDFCT(21),(DT(I,21),I=1,DTN)/0184009,09612,
     +08776,07937,06199,04643,03564,02844,02341,01964,01668,
     +01428,01230,00930,00721,00573,00467,00389,00285,00219,
     +00175,00143,00117,00078,00055,00041,00031,00020,00014/
      DATA ((F(I,J,21),I=1,IN),J=1,JN)/
     +205.,238.,272.,334.,395.,446.,281.,309.,333.,378.,427.,471.,446.,
     +456.,480.,514.,539.,561.,683.,665.,657.,678.,699.,708.,951.,963.,
     +933.,886.,877.,880.,967.,984.,999.,962.,918.,896.,492.,528.,562.,
     +589.,591.,587.,126.,168.,210.,254.,279.,293.,.000,26.5,49.1,82.1,
     +106.,119.,108.,115.,117.,128.,135.,140./
C
C ----- V  -----
C
      DATA MLTFCT(22),ADDFCT(22),(DT(I,22),I=1,DTN)/0176552,09963,
     +08305,07581,06045,04616,03588,02885,02386,02011,01716,
     +01476,01277,00973,00757,00602,00490,00408,00297,00228,
     +00182,00148,00122,00081,00057,00043,00033,00021,00015/
      DATA ((F(I,J,22),I=1,IN),J=1,JN)/
     +207.,243.,281.,348.,414.,467.,283.,313.,340.,390.,445.,492.,444.,
     +459.,486.,524.,553.,579.,683.,662.,660.,687.,710.,722.,954.,961.,
     +928.,888.,886.,891.,979.,991.,999.,958.,917.,901.,486.,535.,563.,
     +588.,589.,587.,124.,173.,211.,253.,278.,292.,.000,25.2,50.6,81.6,
     +104.,117.,107.,112.,118.,127.,134.,139./
C
C ----- CR -----
C
      DATA MLTFCT(23),ADDFCT(23),(DT(I,23),I=1,DTN)/0169973,10308,
     +06969,06427,05291,04231,03434,02849,02403,02049,01761,
     +01523,01323,01014,00792,00631,00514,00427,00310,00237,
     +00188,00154,00127,00085,00060,00044,00034,00022,00015/
      DATA ((F(I,J,23),I=1,IN),J=1,JN)/
     +214.,258.,304.,385.,463.,526.,285.,326.,363.,430.,496.,552.,443.,
     +462.,496.,553.,601.,638.,682.,661.,663.,699.,738.,763.,956.,960.,
     +926.,891.,894.,904.,972.,994.,999.,956.,920.,906.,487.,528.,565.,
     +588.,590.,590.,125.,170.,210.,254.,278.,295.,.000,25.1,46.2,81.5,
     +103.,117.,106.,112.,117.,127.,133.,138./
C
C ----- MN -----
C
      DATA MLTFCT(24),ADDFCT(24),(DT(I,24),I=1,DTN)/0163465,10661,
     +07506,06949,05719,04506,03583,02924,02445,02080,01790,
     +01553,01356,01047,00824,00659,00538,00446,00323,00246,
     +00195,00159,00132,00088,00062,00046,00036,00023,00016/
      DATA ((F(I,J,24),I=1,IN),J=1,JN)/
     +211.,254.,298.,375.,450.,509.,287.,323.,356.,417.,480.,533.,442.,
     +467.,500.,546.,584.,616.,680.,660.,669.,707.,735.,751.,957.,957.,
     +921.,897.,905.,913.,981.,999.,997.,952.,923.,912.,481.,534.,565.,
     +586.,589.,590.,124.,174.,211.,253.,277.,296.,.000,24.0,47.7,81.2,
     +102.,117.,105.,110.,117.,125.,133.,137./
C
C ----- FE -----
C
      DATA MLTFCT(25),ADDFCT(25),(DT(I,25),I=1,DTN)/0157491,11124,
     +07165,06669,05558,04436,03562,02928,02461,02104,01818,
     +01584,01388,01080,00854,00686,00561,00466,00336,00255,
     +00202,00165,00136,00091,00065,00048,00037,00024,00017/
      DATA ((F(I,J,25),I=1,IN),J=1,JN)/
     +215.,261.,308.,390.,469.,531.,290.,330.,365.,431.,498.,554.,443.,
     +473.,509.,559.,600.,635.,679.,662.,675.,719.,750.,766.,964.,954.,
     +919.,903.,916.,925.,975.,999.,996.,951.,927.,919.,489.,536.,568.,
     +587.,591.,594.,126.,174.,215.,254.,280.,299.,.000,25.8,50.1,81.6,
     +103.,119.,106.,112.,117.,127.,133.,138./
C
C ----- CO -----
C
      DATA MLTFCT(26),ADDFCT(26),(DT(I,26),I=1,DTN)/0151161,11477,
     +06854,06410,05401,04361,03534,02924,02471,02121,01841,
     +01610,01416,01110,00883,00712,00583,00485,00350,00265,
     +00209,00170,00141,00094,00067,00050,00039,00025,00017/
      DATA ((F(I,J,26),I=1,IN),J=1,JN)/
     +216.,265.,315.,402.,484.,548.,291.,333.,372.,442.,513.,570.,441.,
     +476.,515.,568.,612.,648.,673.,659.,678.,725.,758.,776.,960.,945.,
     +913.,905.,921.,930.,979.,999.,987.,946.,926.,921.,481.,539.,565.,
     +583.,590.,594.,124.,177.,214.,252.,280.,301.,.000,24.6,51.0,81.0,
     +102.,119.,105.,109.,117.,125.,132.,136./
C
C ----- NI -----
C
      DATA MLTFCT(27),ADDFCT(27),(DT(I,27),I=1,DTN)/0146163,11936,
     +06569,06169,05249,04283,03500,02914,02474,02133,01858,
     +01631,01440,01136,00909,00737,00605,00504,00364,00275,
     +00217,00176,00146,00097,00069,00052,00040,00026,00018/
      DATA ((F(I,J,27),I=1,IN),J=1,JN)/
     +220.,272.,325.,417.,502.,568.,296.,341.,382.,457.,531.,590.,443.,
     +483.,525.,582.,629.,667.,672.,664.,687.,738.,773.,792.,960.,944.,
     +915.,915.,933.,943.,982.,999.,987.,948.,933.,929.,491.,542.,565.,
     +586.,594.,599.,127.,178.,214.,254.,284.,306.,.000,26.8,52.5,81.8,
     +104.,122.,105.,111.,117.,126.,133.,137./
C
C ----- CU -----
C
      DATA MLTFCT(28),ADDFCT(28),(DT(I,28),I=1,DTN)/0140764,12429,
     +05600,05287,04585,03862,03267,02800,02428,02123,01868,
     +01651,01464,01163,00935,00761,00626,00523,00378,00285,
     +00224,00182,00150,00101,00072,00054,00041,00027,00019/
      DATA ((F(I,J,28),I=1,IN),J=1,JN)/
     +230.,292.,354.,461.,558.,633.,301.,359.,412.,503.,589.,656.,444.,
     +489.,540.,619.,683.,732.,670.,665.,692.,755.,807.,841.,965.,939.,
     +914.,918.,941.,959.,975.,999.,983.,947.,935.,931.,495.,539.,570.,
     +587.,597.,603.,128.,177.,218.,256.,288.,311.,.000,27.8,53.8,83.4,
     +106.,126.,106.,113.,117.,127.,133.,138./
C
C ----- ZN -----
C
      DATA MLTFCT(29),ADDFCT(29),(DT(I,29),I=1,DTN)/0136903,12626,
     +06065,05735,04962,04123,03421,02880,02468,02144,01882,
     +01663,01478,01181,00955,00781,00646,00541,00391,00296,
     +00232,00188,00155,00104,00074,00055,00043,00028,00019/
      DATA ((F(I,J,29),I=1,IN),J=1,JN)/
     +225.,284.,343.,443.,535.,604.,301.,352.,400.,483.,563.,625.,446.,
     +494.,542.,605.,658.,699.,669.,670.,702.,760.,798.,818.,965.,939.,
     +918.,929.,951.,962.,984.,999.,983.,951.,943.,941.,486.,539.,568.,
     +588.,599.,606.,127.,179.,215.,256.,290.,313.,.000,25.7,50.4,81.0,
     +105.,126.,104.,109.,116.,125.,131.,137./
C
C ----- GA -----
C
      DATA MLTFCT(30),ADDFCT(30),(DT(I,30),I=1,DTN)/0132790,13077,
     +07108,06629,05564,04486,03629,02997,02531,02179,01903,
     +01679,01492,01197,00973,00800,00665,00558,00405,00306,
     +00240,00194,00160,00107,00076,00057,00044,00029,00020/
      DATA ((F(I,J,30),I=1,IN),J=1,JN)/
     +220.,271.,322.,410.,489.,550.,303.,346.,385.,454.,520.,573.,449.,
     +500.,541.,588.,625.,656.,668.,676.,711.,761.,782.,790.,965.,938.,
     +923.,941.,959.,960.,987.,999.,982.,956.,951.,950.,495.,542.,568.,
     +590.,602.,610.,129.,180.,215.,258.,293.,317.,.000,27.7,51.9,82.1,
     +108.,129.,105.,111.,117.,126.,132.,138./
C
C ----- GE -----
C
      DATA MLTFCT(31),ADDFCT(31),(DT(I,31),I=1,DTN)/0128270,13445,
     +07378,06935,05902,04783,03849,03143,02623,02235,01938,
     +01702,01510,01212,00989,00817,00681,00574,00418,00317,
     +00248,00200,00165,00110,00079,00059,00046,00029,00021/
      DATA ((F(I,J,31),I=1,IN),J=1,JN)/
     +218.,268.,319.,404.,482.,541.,301.,338.,375.,443.,509.,561.,451.,
     +501.,533.,570.,604.,634.,666.,680.,715.,751.,759.,762.,965.,936.,
     +925.,946.,955.,945.,982.,999.,979.,957.,955.,951.,486.,544.,569.,
     +590.,603.,611.,126.,181.,218.,259.,295.,318.,.000,25.8,52.7,82.2,
     +108.,130.,104.,109.,116.,125.,131.,137./
C
C ----- AS -----
C
      DATA MLTFCT(32),ADDFCT(32),(DT(I,32),I=1,DTN)/0124644,13890,
     +07320,06953,06048,04992,04048,03299,02733,02308,01986,
     +01734,01533,01228,01004,00832,00697,00589,00431,00327,
     +00256,00206,00170,00113,00081,00061,00047,00030,00021/
      DATA ((F(I,J,32),I=1,IN),J=1,JN)/
     +220.,272.,324.,412.,492.,554.,300.,335.,373.,445.,514.,570.,455.,
     +502.,527.,559.,597.,631.,666.,686.,720.,742.,743.,746.,964.,936.,
     +932.,953.,951.,931.,985.,999.,979.,962.,962.,954.,493.,546.,569.,
     +591.,606.,614.,129.,182.,218.,261.,298.,321.,.000,27.5,54.2,83.3,
     +111.,133.,104.,110.,117.,126.,132.,138./
C
C ----- SE -----
C
      DATA MLTFCT(33),ADDFCT(33),(DT(I,33),I=1,DTN)/0121773,14189,
     +07205,06895,06105,05132,04211,03446,02849,02393,02045,
     +01776,01562,01245,01018,00847,00711,00603,00444,00337,
     +00264,00212,00175,00116,00083,00062,00048,00031,00022/
      DATA ((F(I,J,33),I=1,IN),J=1,JN)/
     +222.,276.,331.,422.,506.,570.,298.,333.,374.,451.,525.,584.,459.,
     +501.,521.,555.,597.,637.,666.,693.,723.,733.,733.,740.,964.,937.,
     +940.,959.,945.,919.,989.,999.,979.,970.,970.,957.,498.,544.,569.,
     +593.,610.,618.,131.,181.,216.,262.,299.,322.,.000,28.5,51.8,82.8,
     +111.,134.,104.,110.,116.,125.,132.,138./
C
C ----- BR -----
C
      DATA MLTFCT(34),ADDFCT(34),(DT(I,34),I=1,DTN)/0118782,14541,
     +07060,06795,06104,05217,04339,03578,02963,02484,02113,
     +01825,01598,01266,01034,00860,00725,00616,00456,00347,
     +00272,00219,00180,00119,00085,00064,00050,00032,00023/
      DATA ((F(I,J,34),I=1,IN),J=1,JN)/
     +224.,281.,338.,434.,521.,588.,296.,333.,377.,459.,538.,600.,463.,
     +499.,516.,554.,602.,647.,669.,700.,723.,725.,726.,738.,967.,941.,
     +949.,962.,937.,907.,999.,999.,982.,978.,975.,956.,495.,550.,571.,
     +596.,614.,622.,140.,185.,218.,264.,302.,324.,.000,27.7,53.1,83.0,
     +113.,135.,103.,109.,117.,125.,132.,139./
C
C ----- KR -----
C
      DATA MLTFCT(35),ADDFCT(35),(DT(I,35),I=1,DTN)/0114945,15026,
     +06897,06670,06064,05260,04434,03690,03071,02575,02186,
     +01881,01640,01290,01050,00873,00737,00628,00467,00357,
     +00280,00225,00185,00123,00088,00066,00051,00033,00023/
      DATA ((F(I,J,35),I=1,IN),J=1,JN)/
     +227.,286.,345.,444.,535.,605.,294.,333.,380.,467.,550.,615.,465.,
     +495.,510.,552.,607.,656.,669.,702.,718.,713.,719.,737.,966.,942.,
     +952.,955.,922.,892.,989.,999.,981.,980.,972.,946.,497.,547.,573.,
     +597.,614.,622.,131.,183.,220.,267.,303.,325.,.000,28.2,53.8,85.3,
     +115.,137.,104.,110.,116.,125.,133.,139./
C
C ----- RB -----
C
      DATA MLTFCT(36),ADDFCT(36),(DT(I,36),I=1,DTN)/0112967,15313,
     +11778,10073,07402,05658,04566,03773,03149,02651,02254,
     +01938,01686,01319,01068,00887,00749,00640,00478,00365,
     +00290,00233,00188,00126,00090,00067,00052,00034,00024/
      DATA ((F(I,J,36),I=1,IN),J=1,JN)/
     +206.,241.,277.,337.,392.,435.,295.,332.,364.,406.,444.,477.,469.,
     +494.,512.,551.,582.,600.,673.,708.,718.,715.,724.,735.,975.,948.,
     +962.,957.,920.,894.,999.,994.,988.,990.,976.,945.,505.,547.,576.,
     +601.,619.,626.,143.,184.,220.,266.,305.,326.,.000,29.5,52.4,83.4,
     +116.,137.,104.,111.,116.,125.,132.,140./
C
C ----- SR -----
C
      DATA MLTFCT(37),ADDFCT(37),(DT(I,37),I=1,DTN)/0109519,15666,
     +13109,11476,08478,06200,04794,03882,03224,02718,02315,
     +01993,01733,01350,01089,00902,00762,00651,00488,00375,
     +00297,00239,00194,00129,00092,00069,00054,00035,00024/
      DATA ((F(I,J,37),I=1,IN),J=1,JN)/
     +201.,234.,267.,322.,373.,413.,293.,324.,345.,378.,414.,445.,467.,
     +490.,508.,535.,548.,555.,672.,705.,710.,709.,714.,713.,967.,947.,
     +961.,947.,911.,888.,999.,991.,984.,988.,968.,934.,497.,549.,573.,
     +600.,617.,622.,132.,186.,220.,267.,305.,325.,.000,28.4,53.0,83.9,
     +116.,137.,103.,109.,116.,124.,132.,139./
C
C ----- MO -----
C
      DATA MLTFCT(38),ADDFCT(38),(DT(I,38),I=1,DTN)/0099350,17215,
     +10260,09548,08004,06481,05269,04341,03622,03054,02600,
     +02233,01934,01490,01185,00971,00814,00695,00525,00408,
     +00325,00263,00216,00142,00101,00076,00059,00039,00027/
      DATA ((F(I,J,38),I=1,IN),J=1,JN)/
     +213.,258.,303.,380.,451.,507.,289.,324.,358.,419.,479.,528.,467.,
     +479.,496.,533.,570.,601.,681.,702.,692.,690.,701.,713.,958.,960.,
     +965.,922.,884.,865.,999.,992.,994.,991.,948.,908.,504.,551.,574.,
     +605.,619.,615.,135.,187.,222.,273.,307.,323.,.000,30.0,54.1,88.4,
     +119.,137.,102.,109.,115.,124.,133.,140./
C
C ----- AG -----
C
      DATA MLTFCT(39),ADDFCT(39),(DT(I,39),I=1,DTN)/0088538,18956,
     +08671,08244,07267,06215,05293,04522,03878,03339,02886,
     +02505,02185,01688,01335,01082,00897,00758,00568,00444,
     +00357,00291,00241,00159,00113,00084,00066,00043,00030/
      DATA ((F(I,J,39),I=1,IN),J=1,JN)/
     +222.,279.,337.,434.,524.,594.,287.,336.,384.,468.,548.,612.,456.,
     +470.,501.,562.,622.,671.,686.,681.,672.,691.,726.,757.,951.,966.,
     +944.,891.,870.,869.,992.,990.,999.,968.,916.,882.,499.,548.,574.,
     +605.,608.,599.,134.,187.,225.,275.,303.,316.,.000,29.3,53.2,90.8,
     +118.,133.,99.6,106.,114.,123.,131.,137./
C
C ----- CD -----
C
      DATA MLTFCT(40),ADDFCT(40),(DT(I,40),I=1,DTN)/0086573,19416,
     +09232,08764,07666,06464,05427,04592,03922,03375,02922,
     +02542,02223,01724,01366,01107,00916,00773,00578,00451,
     +00362,00297,00246,00163,00115,00086,00067,00044,00031/
      DATA ((F(I,J,40),I=1,IN),J=1,JN)/
     +219.,275.,330.,422.,508.,574.,288.,334.,378.,456.,532.,592.,455.,
     +471.,502.,558.,610.,654.,686.,678.,672.,694.,725.,750.,949.,965.,
     +940.,889.,873.,872.,992.,989.,999.,964.,912.,881.,502.,547.,574.,
     +605.,606.,596.,136.,187.,225.,276.,303.,316.,.000,30.3,54.1,92.0,
     +119.,133.,100.,107.,113.,123.,132.,138./
C
C ----- IN -----
C
      DATA MLTFCT(41),ADDFCT(41),(DT(I,41),I=1,DTN)/0084719,19844,
     +10434,09768,08297,06805,05601,04682,03973,03412,02955,
     +02576,02257,01758,01397,01132,00936,00789,00587,00458,
     +00368,00302,00250,00166,00118,00088,00068,00045,00031/
      DATA ((F(I,J,41),I=1,IN),J=1,JN)/
     +214.,264.,313.,397.,474.,534.,289.,330.,369.,436.,502.,555.,453.,
     +473.,503.,550.,592.,627.,686.,675.,673.,696.,721.,738.,951.,964.,
     +934.,888.,876.,874.,986.,989.,999.,958.,909.,882.,505.,547.,576.,
     +604.,603.,593.,137.,187.,227.,276.,302.,314.,.000,30.9,55.4,92.6,
     +119.,133.,100.,108.,113.,124.,132.,138./
C
C ----- SN -----
C
      DATA MLTFCT(42),ADDFCT(42),(DT(I,42),I=1,DTN)/0082869,20302,
     +10859,10209,08709,07118,05803,04801,04043,03458,02990,
     +02608,02288,01790,01426,01157,00956,00805,00597,00465,
     +00374,00307,00255,00170,00120,00090,00069,00045,00032/
      DATA ((F(I,J,42),I=1,IN),J=1,JN)/
     +213.,262.,310.,391.,467.,525.,289.,327.,362.,428.,492.,544.,452.,
     +474.,502.,542.,580.,613.,686.,673.,674.,696.,713.,725.,950.,962.,
     +929.,889.,878.,874.,986.,990.,999.,953.,907.,883.,508.,546.,576.,
     +604.,601.,591.,137.,187.,227.,276.,301.,314.,.000,31.7,56.0,93.8,
     +119.,133.,100.,108.,113.,124.,133.,138./
C
C ----- SB -----
C
      DATA MLTFCT(43),ADDFCT(43),(DT(I,43),I=1,DTN)/0080497,20471,
     +10974,10387,08976,07386,06010,04940,04131,03514,03030,
     +02640,02318,01819,01453,01181,00976,00821,00608,00472,
     +00379,00311,00259,00173,00122,00091,00071,00046,00033/
      DATA ((F(I,J,43),I=1,IN),J=1,JN)/
     +210.,258.,306.,387.,462.,521.,284.,318.,353.,419.,484.,537.,445.,
     +468.,492.,527.,564.,598.,676.,663.,667.,685.,697.,706.,939.,948.,
     +914.,879.,869.,861.,999.,981.,985.,937.,895.,875.,497.,540.,569.,
     +594.,591.,582.,135.,186.,224.,271.,296.,308.,.000,30.3,54.0,91.5,
     +115.,130.,97.8,105.,111.,121.,130.,135./
C
C ----- I  -----
C
      DATA MLTFCT(44),ADDFCT(44),(DT(I,44),I=1,DTN)/0078680,21331,
     +10905,10434,09235,07764,06379,05234,04341,03658,03130,
     +02715,02380,01871,01503,01227,01016,00855,00630,00487,
     +00391,00321,00268,00179,00127,00095,00073,00048,00034/
      DATA ((F(I,J,44),I=1,IN),J=1,JN)/
     +215.,266.,317.,403.,482.,545.,287.,320.,358.,429.,501.,558.,452.,
     +476.,494.,527.,569.,608.,686.,673.,680.,689.,694.,704.,955.,959.,
     +924.,898.,882.,865.,990.,998.,999.,947.,912.,892.,511.,551.,579.,
     +602.,597.,589.,139.,189.,230.,276.,300.,312.,.000,32.3,56.9,94.1,
     +117.,132.,99.8,108.,113.,124.,132.,137./
C
C ----- XE -----
C
      DATA MLTFCT(45),ADDFCT(45),(DT(I,45),I=1,DTN)/0076705,21695,
     +10794,10371,09274,07884,06529,05374,04454,03742,03191,
     +02759,02414,01897,01526,01248,01036,00871,00642,00495,
     +00397,00325,00272,00183,00130,00097,00075,00049,00034/
      DATA ((F(I,J,45),I=1,IN),J=1,JN)/
     +215.,267.,319.,406.,488.,551.,284.,317.,356.,431.,504.,563.,450.,
     +472.,487.,521.,566.,608.,681.,670.,677.,679.,684.,697.,954.,952.,
     +918.,893.,873.,853.,982.,999.,992.,939.,907.,887.,503.,548.,579.,
     +598.,592.,585.,136.,189.,230.,275.,297.,309.,.000,30.8,57.1,94.1,
     +116.,131.,98.8,106.,112.,123.,131.,136./
C
C ----- CS -----
C
      DATA MLTFCT(46),ADDFCT(46),(DT(I,46),I=1,DTN)/0076222,21947,
     +16508,14106,10525,08201,06649,05471,04547,03822,03255,
     +02809,02453,01923,01548,01269,01055,00888,00654,00502,
     +00405,00332,00272,00186,00132,00098,00076,00050,00035/
      DATA ((F(I,J,46),I=1,IN),J=1,JN)/
     +200.,235.,269.,329.,384.,427.,286.,318.,350.,394.,434.,468.,453.,
     +474.,490.,524.,559.,582.,684.,676.,681.,683.,691.,702.,973.,955.,
     +924.,902.,879.,858.,995.,999.,996.,946.,917.,895.,511.,551.,586.,
     +600.,595.,590.,140.,192.,232.,273.,298.,311.,.000,32.2,57.1,92.2,
     +116.,131.,99.1,107.,113.,124.,131.,136./
C
C ----- BA -----
C
      DATA MLTFCT(47),ADDFCT(47),(DT(I,47),I=1,DTN)/0074751,22283,
     +18267,15854,11675,08682,06829,05570,04628,03895,03318,
     +02861,02494,01951,01570,01288,01073,00904,00666,00511,
     +00411,00337,00277,00189,00134,00100,00078,00051,00036/
      DATA ((F(I,J,47),I=1,IN),J=1,JN)/
     +196.,228.,260.,315.,366.,406.,284.,316.,339.,373.,408.,440.,453.,
     +472.,488.,518.,538.,551.,682.,675.,680.,681.,688.,693.,970.,952.,
     +923.,900.,874.,855.,997.,999.,993.,944.,916.,892.,506.,552.,584.,
     +598.,593.,589.,138.,193.,232.,273.,297.,310.,.000,31.4,57.5,92.0,
     +115.,130.,98.6,106.,113.,123.,130.,136./
C
C ----- EU -----
C
      DATA MLTFCT(48),ADDFCT(48),(DT(I,48),I=1,DTN)/0066380,24880,
     +15563,13867,10722,08267,06673,05574,04740,04072,03525,
     +03075,02703,02136,01730,01429,01198,01016,00752,00575,
     +00457,00372,00307,00209,00150,00113,00087,00057,00040/
      DATA ((F(I,J,48),I=1,IN),J=1,JN)/
     +203.,244.,284.,350.,411.,457.,291.,332.,363.,408.,453.,489.,452.,
     +480.,509.,553.,580.,597.,671.,675.,685.,704.,724.,735.,970.,935.,
     +917.,903.,886.,876.,991.,999.,975.,940.,916.,893.,511.,556.,583.,
     +591.,592.,592.,141.,195.,234.,272.,298.,314.,.000,32.9,60.6,91.8,
     +116.,133.,97.6,106.,112.,123.,129.,135./
C
C ----- AU -----
C
      DATA MLTFCT(49),ADDFCT(49),(DT(I,49),I=1,DTN)/0053581,30143,
     +10573,10195,09251,08106,07003,06035,05214,04526,03952,
     +03472,03070,02446,01995,01661,01407,01208,00918,00717,
     +00572,00465,00384,00256,00184,00139,00108,00071,00050/
      DATA ((F(I,J,49),I=1,IN),J=1,JN)/
     +228.,297.,362.,468.,559.,627.,298.,351.,405.,496.,578.,641.,464.,
     +495.,526.,584.,641.,687.,673.,695.,702.,719.,742.,765.,958.,942.,
     +941.,916.,891.,878.,999.,989.,975.,960.,924.,892.,516.,561.,581.,
     +600.,608.,603.,145.,199.,236.,282.,312.,327.,.000,33.4,60.1,94.8,
     +124.,142.,94.4,103.,110.,120.,128.,135./
C
C ----- HG -----
C
      DATA MLTFCT(50),ADDFCT(50),(DT(I,50),I=1,DTN)/0052810,30462,
     +10964,10555,09533,08299,07128,06116,05272,04572,03991,
     +03507,03102,02471,02015,01676,01419,01218,00926,00724,
     +00579,00471,00389,00259,00186,00141,00110,00072,00050/
      DATA ((F(I,J,50),I=1,IN),J=1,JN)/
     +226.,292.,356.,458.,547.,613.,297.,348.,400.,487.,566.,627.,463.,
     +493.,524.,578.,632.,675.,673.,694.,700.,716.,737.,757.,956.,942.,
     +940.,912.,888.,874.,999.,986.,975.,958.,921.,888.,513.,562.,581.,
     +600.,607.,601.,144.,200.,237.,282.,312.,327.,.000,32.8,60.5,95.0,
     +124.,142.,93.9,102.,109.,119.,128.,134./
C
C ----- PB -----
C
      DATA MLTFCT(51),ADDFCT(51),(DT(I,51),I=1,DTN)/0050561,30305,
     +12597,11979,10516,08888,07461,06310,05395,04662,04066,
     +03573,03162,02522,02055,01708,01444,01239,00942,00738,
     +00591,00482,00399,00265,00190,00144,00122,00073,00052/
      DATA ((F(I,J,51),I=1,IN),J=1,JN)/
     +210.,268.,324.,412.,490.,548.,288.,332.,374.,446.,513.,565.,453.,
     +481.,508.,551.,591.,624.,663.,678.,683.,696.,709.,720.,941.,928.,
     +920.,890.,866.,851.,999.,972.,959.,937.,897.,865.,460.,562.,571.,
     +588.,592.,585.,128.,203.,234.,276.,303.,316.,.000,23.9,58.2,90.6,
     +118.,135.,87.7,89.0,107.,113.,121.,128./
C
C ----- BI -----
C
      DATA MLTFCT(52),ADDFCT(52),(DT(I,52),I=1,DTN)/0051023,31371,
     +13096,12456,10921,09186,07658,06432,05472,04714,04104,
     +03606,03191,02546,02076,01725,01457,01249,00949,00745,
     +00598,00488,00404,00268,00192,00145,00113,00074,00052/
      DATA ((F(I,J,52),I=1,IN),J=1,JN)/
     +216.,273.,328.,416.,493.,551.,295.,338.,379.,450.,516.,568.,462.,
     +492.,519.,557.,595.,627.,676.,692.,699.,711.,720.,727.,951.,946.,
     +938.,909.,885.,868.,999.,983.,978.,956.,916.,885.,517.,560.,579.,
     +602.,606.,598.,146.,199.,236.,283.,312.,325.,.000,33.6,59.4,95.5,
     +124.,141.,93.3,102.,109.,118.,127.,134./
C
C ----- RN -----
C
      DATA MLTFCT(53),ADDFCT(53),(DT(I,53),I=1,DTN)/0049340,32366,
     +13492,12949,11565,09854,08223,06852,05762,04912,04244,
     +03711,03277,02616,02135,01775,01499,01283,00974,00765,
     +00615,00503,00418,00278,00199,00150,00117,00077,00054/
      DATA ((F(I,J,53),I=1,IN),J=1,JN)/
     +216.,273.,328.,416.,494.,553.,293.,330.,371.,443.,512.,565.,463.,
     +491.,509.,540.,579.,614.,679.,692.,698.,699.,699.,705.,951.,949.,
     +938.,909.,880.,855.,999.,987.,982.,954.,914.,884.,517.,561.,581.,
     +603.,605.,596.,146.,200.,238.,285.,312.,324.,.000,33.4,59.8,97.0,
     +125.,141.,93.0,101.,108.,119.,128.,134./
C
C ----- U  -----
C
      DATA MLTFCT(54),ADDFCT(54),(DT(I,54),I=1,DTN)/0046265,34222,
     +19119,17436,14052,11069,08928,07387,06221,05307,04576,
     +03985,03503,02775,02257,01875,01582,01353,01024,00803,
     +00649,00534,00443,00297,00212,00159,00124,00082,00058/
      DATA ((F(I,J,54),I=1,IN),J=1,JN)/
     +200.,243.,284.,350.,409.,454.,288.,323.,351.,398.,443.,480.,461.,
     +482.,500.,527.,549.,565.,681.,688.,688.,685.,687.,689.,952.,950.,
     +933.,897.,862.,839.,999.,985.,984.,947.,906.,871.,520.,559.,582.,
     +603.,600.,589.,148.,201.,239.,285.,310.,320.,.000,34.0,59.7,97.6,
     +124.,139.,91.8,101.,107.,118.,127.,133./
C
C ----------------------- Initialise variables -------------------------
C
        ISTAT = 0
        BETA  = 1.D0
        FE    = 0.D0
        FA    = 0.D0
        MS2   = M * S * S
        DWF   = DEXP( -MS2 )
        ELNUM = ( 2 + INDEX( ELNAMS, ELNAME//' ' ) ) / 3
C
C ------------------------- Check parameters ---------------------------
C
        IF ( ELNUM.EQ.0 )                       ISTAT = 1
        IF ( M.LT.0.D0.OR.M.GT.GM( IN ) )       ISTAT = 2
        IF ( S.LT.0 )                           ISTAT = 3
        IF ( KVOLTS.LT.0.D0.OR.KVOLTS.GT.1.D4 ) ISTAT = 4
        IF ( ISTAT.GT.0.AND.STATUS.LT.0 ) THEN
         WRITE ( -STATUS, '(/2A//A/)' )
     +         ' ATOM error - ', ERRMSG( ISTAT ),
     +         ' Execution terminated.'
         STOP
        ENDIF
        IF ( STATUS.GE.0 ) STATUS = ISTAT
        IF ( STATUS.GT.0.OR.
     +       MS2.GT.GMS2( JN ).OR.S.GT.DTS( DTN ) ) GOTO 9999
C
C ----- Calculate BETA if voltage isn't zero -----
C
        IF ( KVOLTS.GT.0 ) BETA = SQRT( 1.D0 - 261127.D0 /
     +                            ( 261127.D0 +
     +                            KVOLTS * ( KVOLTS + 1022.D0 ) ) )
C
C ----- Interpolate real part -----
C
        I0 = 2
1010    I0 = I0 + 1
        IF ( S.GT.DTS( I0 ).AND.I0.LT.( DTN - 1 ) ) GOTO 1010
C
        RF( 1 ) = REAL( DT( I0 - 2, ELNUM ) )
        RF( 2 ) = REAL( DT( I0 - 1, ELNUM ) )
        RF( 3 ) = REAL( DT( I0    , ELNUM ) )
        RF( 4 ) = REAL( DT( I0 + 1, ELNUM ) )
        FE = DWF * CINT( DTS( I0 - 2 ), S, RF ) / 1.D3
C
        IF ( M.LT.GM( 1 ) ) GOTO 9999
C
        RMLT = 10. / REAL( MLTFCT( ELNUM ) )
        RADD = 1.E-6 * REAL( ADDFCT( ELNUM ) )
C
        I0 = 1
1020    I0 = I0 +1
        IF ( M.GE.GM (I0 ).AND.I0.LT.IN ) GOTO 1020
C
        IF ( MS2.GE.GMS2( JN - 2 ) ) THEN
C
C ----- Interpolate absorptive part using cubic -----
C
         IF ( I0.LT.3 )  I0 = 3
         IF ( I0.EQ.IN ) I0 = IN - 1
         I0 = I0 - 3
         J0 = JN - 4
C
         DO 1050 J = 1, 4
          EXPMS2 = EXP( REAL( GMS2( J0 + J ) ) )
          DO 1040 I = 1, 4
           RF( I ) = EXPMS2 *
     +         ( F( I0 + I, J0 + J, ELNUM ) * RMLT - RADD )
1040      CONTINUE
          FATM( J ) = REAL( CINT( GM( I0 + 1 ), M, RF ) )
1050     CONTINUE
C
         FA = FE / BETA * CINT( GMS2( J0 + 1 ), MS2, FATM )
C
        ELSE
C
C ----- Interpolate absorptive part using quadratic -----
C
         COUNT = 0
         BFLAG = 1
         LFLAG = 1
         RFLAG = 1
         DO 2010 J = 1, 5
          DO 2000 I = 1, 4
          QF( I, J ) = 0.0
2000      CONTINUE
2010     CONTINUE
C
         J0 = 1
1110     J0 = J0 + 1
         IF ( MS2.GE.GMS2( J0 ).AND.J0.LT.JN ) GOTO 1110
C
         I0 = I0 - 3
         J0 = J0 - 3
         DO 1150 J = 1, 4
          J1 = J0 + J
          IF ( J1.EQ.0 ) THEN
           BFLAG = 0
          ELSE
           EXPMS2 = EXP( REAL( GMS2( J1 ) ) )
           DO 1140 I = 1, 4
            I1 = I0 + I
            IF ( I1.EQ.0 ) THEN
             LFLAG = 0
            ELSEIF ( I1.EQ.( IN + 1 ) ) THEN
             RFLAG = 0
            ELSE
             QF( I, J ) = EXPMS2 * ( F( I1, J1, ELNUM ) * RMLT - RADD )
            ENDIF
1140       CONTINUE
          ENDIF
1150     CONTINUE
C
         IF ( BFLAG.EQ.1.AND.LFLAG.EQ.1 ) THEN
          FA = FA + BIQINT( M, MS2, GM( I0 + 1 ),
     +                      GMS2( J0 + 1 ), QF( 1, 1) )
          COUNT = COUNT + 1
         ENDIF
         IF ( BFLAG.EQ.1.AND.RFLAG.EQ.1 ) THEN
          FA = FA + BIQINT( M, MS2, GM( I0 + 2 ),
     +                      GMS2( J0 + 1 ), QF( 2, 1) )
          COUNT = COUNT + 1
         ENDIF
         IF ( LFLAG.EQ.1 ) THEN
          FA = FA + BIQINT( M, MS2, GM( I0 + 1 ),
     +                      GMS2( J0 + 2 ), QF( 1, 2) )
          COUNT = COUNT + 1
         ENDIF
         IF ( RFLAG.EQ.1 ) THEN
          FA = FA + BIQINT( M, MS2, GM( I0 + 2 ),
     +                      GMS2( J0 + 2 ), QF( 2, 2) )
          COUNT = COUNT + 1
         ENDIF
C
         FA = FA * FE / ( BETA * DBLE( COUNT ) )
C
        ENDIF
C
9999    RETURN
        END
C
C ----------------------------------------------------------------------
        FUNCTION BIQINT( M, MS2, GM, GMS2, F )
C ----------------------------------------------------------------------
C
        DOUBLE PRECISION BIQINT, M, MS2, GM( 3 ), GMS2( 3 ), QINT
        REAL F( 4, 3 ), FATM( 3 )
C
        FATM( 1 ) = REAL( QINT( GM, M, F( 1, 1 ) ) )
        FATM( 2 ) = REAL( QINT( GM, M, F( 1, 2 ) ) )
        FATM( 3 ) = REAL( QINT( GM, M, F( 1, 3 ) ) )
C
        BIQINT    = QINT( GMS2, MS2, FATM )
C
        END
C
C ----------------------------------------------------------------------
        FUNCTION QINT( X, XX, F )
C ----------------------------------------------------------------------
C
        DOUBLE PRECISION QINT, X( 3 ), XX
        DOUBLE PRECISION X1, X2, X3, X12, X13, X23
        REAL F( 3 )
C
C ----- Use Lagrange interpolating quadratic -----
C
        X1  = XX - X( 1 )
        X2  = XX - X( 2 )
        X3  = XX - X( 3 )
        X12 = X( 1 ) - X( 2 )
        X13 = X( 1 ) - X( 3 )
        X23 = X( 2 ) - X( 3 )
C
        QINT = DBLE( F( 1 ) ) * X2 * X3 / ( X12 * X13 ) -
     +         DBLE( F( 2 ) ) * X1 * X3 / ( X12 * X23 ) +
     +         DBLE( F( 3 ) ) * X1 * X2 / ( X13 * X23 )
C
        END
C
C ----------------------------------------------------------------------
        FUNCTION CINT( X, XX, F )
C ----------------------------------------------------------------------
C
        DOUBLE PRECISION CINT, X( 4 ), XX
        DOUBLE PRECISION X1, X2, X3, X4, X12, X13, X14, X23, X24, X34
        REAL F( 4 )
C
C ----- Use Lagrange interpolating cubic -----
C
        X1  = XX - X( 1 )
        X2  = XX - X( 2 )
        X3  = XX - X( 3 )
        X4  = XX - X( 4 )
        X12 = X( 1 ) - X( 2 )
        X13 = X( 1 ) - X( 3 )
        X14 = X( 1 ) - X( 4 )
        X23 = X( 2 ) - X( 3 )
        X24 = X( 2 ) - X( 4 )
        X34 = X( 3 ) - X( 4 )
C
        CINT = DBLE( F( 1 ) ) * X2 * X3 * X4 / ( X12 * X13 * X14 ) -
     +         DBLE( F( 2 ) ) * X1 * X3 * X4 / ( X12 * X23 * X24 ) +
     +         DBLE( F( 3 ) ) * X1 * X2 * X4 / ( X13 * X23 * X34 ) -
     +         DBLE( F( 4 ) ) * X1 * X2 * X3 / ( X14 * X24 * X34 )
C
        END
C
C ----------------------------------------------------------------------
C                          End of file atom.p
C ----------------------------------------------------------------------