From:	AUVAX::SE%"BROWN@nflett.UU.SE" 27-MAR-1989 04:02
To:	SNYDER@CERAMICS.BITNET
Subj:	2 of 4

Received: From SEMAX51(MAILER) by CERAMICS with Jnet id 2099
          for SNYDER@CERAMICS; Mon, 27 Mar 89 03:58 EDT
Date: Mon, 27 Mar 89 10:41 +0100
From: BROWN@nflett.UU.SE
Subject: 2 of 4
To: SNYDER@CERAMICS.BITNET
X-VMS-To: BMC1::IN%"SNYDER@CERAMICS"
 
      PROGRAM LPX1
      DIMENSION CAR(9), IPOS(45), TSS(24,3), SS(24,3,3), FA(4,8), FB(4,8
     1), FC(8), RN(3), RD(3), S1(3), S2(3), S3(3), XYZ(3), COMPND(19), E
     2LEMT(8), X(50,8), Y(50,8), Z(50,8), FOCCU(50,8), FMULT(50,8), FNEU
     3T(8), NA(8), TS(3,24), FS(3,3,24), BTEMP(50,8), DELFR(8), DELFI(8)
     4, IDE(50,8), IGR(45)
      INTEGER CEN,CAR,SS,ASYMB,ELEMT,ELEMT1,SYMWL,SYMBR,SYMLP
      COMMON /INPUT/ COMPND,ELEMT,X,Y,Z,FOCCU,FMULT,FNEUT,A,B,C,ALPHA,BE
     1TA,GAMMA,SYMSY,SYMBR,ISYMCE,NCOMPO,NA,SYMWL,WL,TL,TH,NORM,IMAGE,SY
     2MLP,AGUIN,BGUIN,BTEMP,DELFR,DELFI,IANO,NS,IBRAVL
      COMMON /UNITS/ ICR,IPR,ILU
      COMMON /POSIT/ RN,RD,S1,S2,S3,IGR
      COMMON /ANOMAL/ DEL1,DEL2
      COMMON /NEU/ FNEU
      COMMON /SCAT/ FA,FB,FC
      COMMON /EXTI/ IHOO,IOKO,IOOL,IHKO,IHOL,IOKL,IHHL,LAUE,ITRIG
      COMMON /EQUI/ TS,FS
      COMMON /BURZ/ TSS,SS
      COMMON /SLAS/ IP(8,3)
      CHARACTER*15 INDAT,LISTA,LPX12
      DATA CAR(1)/'TI'/,CAR(2)/'AT'/,CAR(3)/'CE'/,CAR(4)/'LA'/,CAR(5)/'S
     1Y'/,CAR(6)/'CO'/,CAR(7)/'SP'/,CAR(8)/'EN'/,CAR(9)/'FI'/
      DATA IBLNK/'BBBB'/
      DATA I4HCU/'CU  '/,I1HP/'P'/,I2H/'  '/,I1HA/'A'/,I1H/' '/,
     *I1HN/'N'/,I1HC/'C'/,I4H/'    '/
C
      OPEN ( 5,FILE = 'LAZY',STATUS = 'OLD')
      OPEN ( 6,FILE = 'CARD',STATUS = 'NEW')
      OPEN (11,FILE = 'PULVX.INP', STATUS = 'NEW',FORM = 'UNFORMATTED')
      OPEN (12,FILE = 'DKLFJ', STATUS = 'SCRATCH')
C-----SET LOGICAL UNIT NUMBERS
      REWIND 5
C     ICR="LAZY-PULVERIX INPUT DATA FILE"
      ICR=5
C     IPR="PRINTER OUTPUT FILE"
      IPR=6
C     ILU="LPX12-INPUT-FILE FOR LPX2
      ILU=11
C     ILV="ICARD-TEMPORARY FILE"
      ILV=12
C     SORD VERSION DEC.84    M. WESTDAHL   SU.
C
C      LDIS=0
C     "LAZY-PULVERIX INPUT DATA FILE"
C      WRITE(LDIS,101)
C  101 FORMAT (' LAZY-PULVERIX INPUT DATA FILE ='$)
C  102 FORMAT (A)
C      READ (LDIS,102) INDAT
CC     "PRINTER OUTPUT FILE"
C      WRITE (LDIS,104)
C  104 FORMAT (' PRINTER OUTPUT FILE ='$)
C      READ (LDIS,102) LISTA
CC     "INPUT FILE FOR LPX2=LPX12"
C      WRITE (LDIS,105)
C  105 FORMAT (' INPUT-FILE FOR LPX2 ='$)
C      READ (LDIS,102)LPX12
C      OPEN(UNIT=ICR,FILE=INDAT,STATUS='OLD',ERR=9851)
C      OPEN(UNIT=IPR,FILE=LISTA,STATUS='NEW',ERR=9852)
C      OPEN(UNIT=ILU,FILE=LPX12,STATUS='NEW',FORM='UNFORMATTED',
C     *ERR=9853)
CC     SCRATCH FILE=ICARD
C      OPEN(UNIT=ILV,STATUS='SCRATCH',ERR=9854)
C      GO TO 9855
C 9851 WRITE(LDIS,*) ' OPEN ERROR ON IN-DATA FILE '
C      GO TO 9856
C 9852 WRITE(LDIS,*) ' OPEN ERROR ON LIST FILE '
C      GO TO 9856
C 9853 WRITE(LDIS,*) ' OPEN ERROR ON TRANSFER FILE '
C      GO TO 9856
C 9854 WRITE(LDIS,*) ' OPEN ERROR ON SCRATCH FILE '
C      GO TO 9856
C 9855 CONTINUE
C-----SET PROGRAM LIMITS
      LIMIT2=8
      LIMIT3=50
      LIMIT4=24
C-----CALL SCATTERING FACTOR TABLES
C-----FOLLOWING SIX SUBROUTINES ARE REPLACED BY A BLOCK DATA SUBPROGRAM
C-----IN THIS IBM 370 VERSION
C     CALL CONF1
C     CALL CONF2
C     CALL CONF3
C     CALL CONF4
C     CALL CONF5
C     CALL CONF6
C-----
C-----READ INPUT FOR SEVERAL JOBS
C-----
      NJOB=0
      WRITE (IPR,38)
C-----READ FIRST CARD OF EACH SET
 1    READ (ICR,39) (IPOS(I),I=1,40)
C-----CHECK FOR FINISH CARD
      IF (IPOS(1).EQ.CAR(9)) GO TO 4
C-----COUNT NUMBER OF JOBS
      NJOB=NJOB+1
      WRITE (IPR,40) NJOB
      GO TO 3
C-----READ REMAINING DATA CARDS
 2    READ (ICR,39) (IPOS(I),I=1,40)
 3    WRITE (IPR,41) (IPOS(I),I=1,40)
C-----WRITE DATA CARDS TWICE ON DISK
      WRITE (ILV,39) (IPOS(I),I=1,40)
      WRITE (ILV,39) (IPOS(I),I=1,40)
C-----CHECK FOR END OF JOB
      IF (IPOS(1).NE.CAR(8)) GO TO 2
      WRITE (IPR,42)
      GO TO 1
 4    REWIND ILV
C-----
C-----START CALCULATION FOR NJOB JOBS
C-----
      WRITE (ILU) NJOB
      DO 37 IJOB=1,NJOB
C-----
C-----SET DEFAULT VALUES
C-----
      ISYMWL=I4HCU
      SYMBR=I1HP
      ISYMLP=I2H
      CEN=I1HA
      NORM=I1H
      WL=1.5418
      TL1=0.
      TH1=89.
      THG=50.
      IMAGE=2
      IANO=I1H
C-----
C-----SET PARAMETERS BACK TO ORIGINAL VALUE
C-----
      LAUE=0
      ITRIG=3
      IHOO=1
      IOKO=1
      IOOL=1
      IHHL=1
      IHOL=1
      IOKL=1
      IHKO=1
      NCOMPO=1
      TH=TH1
      TL=TL1
      SYMWL=ISYMWL
      NS=0
      IGROUP=0
      INADD=0
      ISYST=0
      ISYMCE=0
      A=0.
C-----SET ARRAYS BACK ZERO
      DO 5 I=1,36
 5    IGR(I)=I1H
      DO 6 I=1,LIMIT2
      ELEMT(I)=IBLNK
      FNEUT(I)=0.
      DELFR(I)=0.
      DELFI(I)=0.
      FC(I)=0.
      DO 6 J=1,4
      FA(J,I)=0.
      FB(J,I)=0.
 6    NA(I)=0
      DO 7 I=1,3
      DO 7 J=1,3
      DO 7 K=1,LIMIT4
      TS(I,K)=0.
      FS(I,J,K)=0.
 7    CONTINUE
C-----TRIVIAL POSITION X,Y,Z
      FS(1,1,1)=1.
      FS(2,2,1)=1.
      FS(3,3,1)=1.
C-----LOOP OVER ALL DATA CARDS ON FILE ILV FOR ONE SET
 8    READ (ILV,43) INDF
C-----READ FIRST RECORD TO IDENTIFY FORMAT
      DO 9 J=1,8
      IF (INDF.NE.CAR(J)) GO TO 9
      M=J
      GO TO 10
 9    CONTINUE
      WRITE (IPR,44) INDF
      GO TO 35
C-----READ SECOND RECORD WITH CORRECT FORMAT
 10   GO TO (11,12,16,18,19,23,24,26), M
C-----T I T L E  CARD
 11   READ (ILV,45) (COMPND(I),I=1,19)
      GO TO 8
C-----A T O M  CARD
 12   READ (ILV,46) ELEMT1,IDE1,((IP(I,J),I=1,8),J=1,3),B1,FOCCU1
      CALL SLASH (XYZ)
      IF (FOCCU1.EQ.0.)FOCCU1=1.
      DO 13 I=1,NCOMPO
      NC=I
C-----ADD ATOM TO SAME ATOM KIND
      IF (ELEMT1.EQ.ELEMT(NC)) GO TO 14
 13   CONTINUE
C-----STORE ATOM AS NEW ATOMKIND
      IF (NA(1).EQ.0) GO TO 14
      NCOMPO=NCOMPO+1
      NC=NCOMPO
      IF (NCOMPO.LE.LIMIT2) GO TO 14
      WRITE (IPR,47) LIMIT2
      GO TO 35
 14   NA(NC)=NA(NC)+1
      I=NA(NC)
      IF (NA(NC).LE.LIMIT3) GO TO 15
      WRITE (IPR,48) NA(NC),ELEMT1,LIMIT3
      GO TO 35
 15   X(I,NC)=XYZ(1)
      Y(I,NC)=XYZ(2)
      Z(I,NC)=XYZ(3)
      ELEMT(NC)=ELEMT1
      IDE(I,NC)=IDE1
      FOCCU(I,NC)=FOCCU1
      BTEMP(I,NC)=B1
      GO TO 8
C-----C E L L  CARD
 16   READ (ILV,49) A,B,C,ALPHA,BETA,GAMMA
C-----CRYSTAL SYSTEM
      ISYSTM=2
      IF (B.NE.0.)GO TO 17
      IF (GAMMA.EQ.0.)ISYSTM=4
      IF (GAMMA.EQ.120.) ISYSTM=6
      IF (C.EQ.0.)ISYSTM=5
 17   IF (BETA.NE.0.)ISYSTM=1
      IF ((BETA.NE.0.).AND.(ALPHA.NE.0.)) ISYSTM=7
      GO TO 8
C-----L A T I C E  CARD
 18   READ (ILV,50) CEN,SYMBR
      IF (CEN.EQ.I1HC) ISYMCE=1
      GO TO 8
C-----S Y M T R Y  CARD
 19   READ (ILV,51) (IGR(J),J=1,45)
      CALL EQVP
      IF (RN(1).EQ.999.9) GO TO 35
      NS=NS+1
      IF (NS.LE.LIMIT4) GO TO 20
      WRITE (IPR,52) LIMIT4
      GO TO 35
 20   DO 22 J=1,3
      IF (RD(J).EQ.0.) GO TO 21
      RD(J)=RN(J)/RD(J)
 21   TS(J,NS)=RD(J)
      FS(1,J,NS)=S1(J)
      FS(2,J,NS)=S2(J)
      FS(3,J,NS)=S3(J)
 22   CONTINUE
      GO TO 8
C-----C O N D I T  CARD
 23   READ (ILV,53) SYMWL,WL,TL,TH,NORM,IMAGE,SYMLP,IANO,NADD,NOLD
C-----REPLACE BLANKS BY DEFAULT SYMBOLS
      IF (SYMWL.EQ.I4H   ) SYMWL=ISYMWL
      IF(TH.EQ.0.) TH=TH1
      IF(TH.GT.TH1) TH=TH1
      IF(TH.LT.TL)  TH=TL
      GO TO 8
C-----S P C G R P  CARD
 24   READ (ILV,54) (IGR(I),I=1,36)
      ISYST=0
      IGROUP=1
      CALL BURZL (ISYST,ISY,ISYB,NG)
      NS=NG
      SYMBR=ISYB
      ISYMCE=ISY
C-----MAKE ARRAY FROM BURZ COMPATIBLE WITH P U L V E R I X
      DO 25 I=1,3
      DO 25 IJ=1,3
      DO 25 IK=1,NS
      FS(I,IJ,IK)=SS(IK,IJ,I)
      TS(IJ,IK)=TSS(IK,IJ)
 25   CONTINUE
      GO TO 8
C-----END OF FORMAT INTERPRETATION
 26   READ (ILV,43) INDF
C-----CHECK FOR CELL AND ATOM CARD
      IF (NA(1).NE.0) GO TO 27
      WRITE (IPR,55)
      GO TO 36
 27   IF (A.NE.0.)GO TO 28
      WRITE (IPR,56)
      GO TO 36
C-----LORENTZ POLARISATION FACTOR
 28   KODLP=LP(SYMLP)
C-----CENTER OF SYMMETRY AT ORIGIN
      IF (CEN.EQ.I1HC) ISYMCE=1
C-----WAVELENGTH
      IF (WL.LT.0.1) WL=WAVE(SYMWL)
C-----LIMIT UPPER SIN**2 THETA VALUE FOR GUINIER CAMERA
      IF ((KODLP.GT.2).AND.(TH.GT.45.)) TH=THG
C-----TABULAR OUTPUT FEATURE
      IF (NORM.EQ.I1H) INORM=0
      IF ((IANO.EQ.I1H).AND.(ISYMCE.EQ.0)) INORM=2
      IF (NORM.EQ.I1HA) INORM=1
      IF (NORM.EQ.I1HN) INORM=3
      IF (NADD.EQ.I1H) INADD=0
      IF (NADD.EQ.I1HA) INADD=1
      IF (NOLD.EQ.I1H) INOLD=0
      IF (NOLD.EQ.I1HA) INOLD=1
C-----DEFAULT SYMMETRY OPERATOR
      IF (NS.EQ.0) NS=1
C-----DERIVE BRAVAIS LATTICE INDICATOR
      IBRAVL=BRA(SYMBR)
C-----CALCULATE MULTIPLICITIES OF SPECIAL ATOM POSITIONS
      CALL MULTF
C-----ANOMALOUS  DISPERSION INDICATOR
      ANO=0.
      IF ((IANO.EQ.I1H).AND.(KODLP.NE.2)) ANO=1.
C-----CHECK CRYSTAL SYSTEM
      IF (ISYST.EQ.0) GO TO 29
      IF (ISYST.EQ.ISYSTM) GO TO 29
      WRITE (IPR,57)
C-----TAKE CRYSTAL SYSTEM FROM GROUP CARD
      ISYSTM=ISYST
C-----CALCULATE EXTINCTIONS,LAUE GROUP AND TRIGONAL SYMMETRY INDICATOR
 29   CALL EXTINC (ISYMCE,NS)
      IF (ISYSTM.EQ.6) ISYSTM=ITRIG
C-----RETRIEVE SCATTERING FACTORS FOR X RAY,NEUTRON AND ANOM.DISP.
      DO 33 I=1,NCOMPO
      FNEU=0.
      NC=I
      DELFR(I)=0.
      ASYMB=ELEMT(NC)
      DELFI(I)=0.
      IF (KODLP.NE.2) GO TO 31
C-----RETRIEVE NEUTRON SCATTERING LENGTH
      CALL ANOMA (SYMWL,ELEMT(NC),KODLP)
      IF (FNEU.NE.0.) GO TO 30
      WRITE (IPR,58) ELEMT(NC)
      GO TO 36
 30   FNEUT(NC)=FNEU
      GO TO 33
 31   IF ( ANO .EQ.0.) GO TO 32
C-----RETRIEVE ANOMALOUS DISPERSION COEFFICIENTS
      CALL ANOMA (SYMWL, ASYMB   ,KODLP)
      DELFR(NC)=DEL1
      DELFI(NC)=DEL2
C-----RETRIEVE CROMER-MANN COEFFICIENTS
 32   CALL FSC (ASYMB,NC)
      IF (FC(NC).EQ.999.9) GO TO 36
 33   CONTINUE
C-----WRITE DATA FOR FOLLOWING PROGRAM PULVR2 ON UNIT ILU
      WRITE (ILU) (COMPND(I),I=1,19),A,B,C,ALPHA,BETA,GAMMA,WL,(IGR(I),I
     1=1,36),IGROUP,INADD,INOLD
      WRITE (ILU) ISYSTM,ISYMCE,IBRAVL,NS,TL,TH,INORM,IMAGE,ANO,KODLP,NC
     1OMPO,(NA(I),I=1,8),IHOO,IOKO,IOOL,IHHL,IHOL,IHKO,IOKL,LAUE
      WRITE (ILU) ((TS(I,II),(FS(K,I,II),K=1,3),I=1,3),II=1,NS)
      DO 34 M=1,NCOMPO
      NL=NA(M)
      WRITE (ILU) DELFR(M),DELFI(M)
      WRITE (ILU) ELEMT(M),(FA(I,M),FB(I,M),I=1,4),FC(M),FNEUT(M)
      WRITE (ILU) (ELEMT(M),IDE(I,M),X(I,M),Y(I,M),Z(I,M),FMULT(I,M),FOC
     1CU(I,M),BTEMP(I,M),I=1,NL)
 34   CONTINUE
      WRITE (IPR,59) IJOB
      GO TO 37
C-----SKIP RECORDS UNTIL END CARD
 35   READ (ILV,43) INDF
      IF (INDF.NE.CAR(8)) GO TO 35
      READ(ILV,43) INDF
 36   WRITE (IPR,60) IJOB
C-----WRITE ONE DUMMY RECORD FOR BAD JOB
      A=-1.
      WRITE (ILU) (COMPND(I),I=1,19),A,B,C,ALPHA,BETA,GAMMA,WL,(IGR(I),I
     1=1,36),IGROUP,INADD,INOLD
 37   CONTINUE
C-----END OF DATA PREPARATION
      REWIND ILU
      WRITE (IPR,61)
 9856 CONTINUE
      STOP
C-----
 38   FORMAT (1H1,///15H START  L A Z Y/////)
 39   FORMAT (40A2)
 40   FORMAT (//12H INPUT CARDS//4H JOB,I6//3H *.,8(10H*********.),1H*)
 41   FORMAT (3H * ,40A2,1H*)
 42   FORMAT (3H *.,8(10H*********.),1H*)
 43   FORMAT (A2)
 44   FORMAT (16H FORMAT LETTERS ,A2,15H NOT RECOGNIZED)
 45   FORMAT (6X,18A4,A2)
 46   FORMAT (7X,A4,A2,3(8A1),F6.2,F5.2)
 47   FORMAT (6H ONLY ,I5,19H ATOM KINDS ALLOWED)
 48   FORMAT (I5,9H ATOMS OF,A4,15H NUMBER ALLOWED,I5)
 49   FORMAT (13X,3F8.0,3F9.0)
 50   FORMAT (8X,A1,2X,A1)
 51   FORMAT (6X,45A1)
 52   FORMAT (10H MORE THAN,I5,13H SYMTRY CARDS)
 53   FORMAT (10X,A4,F6.0,2F5.0,1X,A1,I2,A2,3(1X,A1))
 54   FORMAT (6X,36A1)
 55   FORMAT (23H NO ATOM CARD WAS FOUND)
 56   FORMAT (23H NO CELL CARD WAS FOUND  )
 57   FORMAT (/12H * WARNING */,76H CRYSTAL SYSTEM SPECIFIED ON CELL CAR
     1D AND ON GROUP CARD ARE NOT CONSISTENT  )
 58   FORMAT (37H NEUTRON SCATTERING LENGTH FOR SYMBOL,2X,A4,19H HAS NOT
     1 BEEN FOUND)
 59   FORMAT (/4H JOB,I6,5H OK  /)
 60   FORMAT (/5H JOB ,I5,7H FAILED//)
 61   FORMAT (///16H END OF  L A Z Y)
      END
C
C------------------------------------------------------------------------------
      FUNCTION WAVE (SYML)
C------------------------------------------------------------------------------
C
C-----DERIVES WAVELENGTH FOR RADIATION SYMBOL SYML
      COMMON /WAVEL/ CS
      INTEGER CS,SYML
      DIMENSION CS(20), W(20)
      DATA W(1)/2.28970/,W(2)/2.29361/,W(3)/2.0848/,W(4)/2.2909/,W(5)/1.
     193604/,W(6)/1.93998/,W(7)/1.75653/,W(8)/1.9373/,W(9)/1.54056/,W(10
     2)/1.54439/,W(11)/1.39217/,W(12)/1.5418/,W(13)/0.70930/,W(14)/0.713
     359/,W(15)/0.63225/,W(16)/0.7107/,W(17)/0.55941/,W(18)/0.56380/,W(1
     49)/0.49701/,W(20)/0.5608/
      DO 1 I=1,20
      IF (SYML-CS(I)) 1,2,1
 1    CONTINUE
      WAVE=W(12)
      RETURN
 2    WAVE=W(I)
      RETURN
      END
C
C-------------------------------------------------------------------------------
      FUNCTION LP (SYMLP)
C-------------------------------------------------------------------------------
C
C-----ASSIGNS SEQUENCE NUMBER LP TO EACH LOR.POL. SYMBOL SYMLP
C-----BELOW COMMON INACTIVATED IN THE IBM 370/165 VERSION
C-----IT IS NOT USED IN ANY OTHER ROUTINE
C     COMMON /FLOR/ LPF,CS
      DIMENSION LPF(7), CS(7)
      INTEGER CS,SYMLP
      DATA LPF(1)/0/,LPF(2)/1/,LPF(3)/2/,LPF(4)/3/,LPF(5)/4/,LPF(6)/0/,
     1     LPF(7)/5/
      DATA CS(1)/'DS'/,CS(2)/' 1'/,CS(3)/'NE'/,CS(4)/'GN'/,CS(5)/'GH'/,C
     1S(6)/'  '/,CS(7)/'SY'/
      DO 1 I=1,7
      IF (SYMLP-CS(I)) 1,2,1
 1    CONTINUE
      LP=LPF(1)
      RETURN
 2    LP=LPF(I)
      RETURN
      END
C
C----------------------------------------------------------------------------
      FUNCTION BRA (SYMBR)
C----------------------------------------------------------------------------
C
C-----ASSIGNS SEQUENCE NUMBER BRA TO BRAVAIS LATTICE SYMBOL SYMBR
C-----BELOW COMMON INACTIVATED IN THE IBM 370/165 VERSION
C-----IT IS NOT USED IN ANY OTHER SUBROUTINE
C     COMMON /BRAF/ IB,CS
      INTEGER CS,SYMBR
      DIMENSION IB(8), CS(8)
      DATA IB(1)/1/,IB(2)/1/,IB(3)/2/,IB(4)/3/,IB(5)/4/,IB(6)/5/,IB(7)/6
     1/,IB(8)/7/
      DATA CS(1)/' '/,CS(2)/'P'/,CS(3)/'I'/,CS(4)/'R'/,CS(5)/'F'/,CS(6)/
     1'A'/,CS(7)/'B'/,CS(8)/'C'/
      DO 1 I=1,8
      IF (SYMBR-CS(I)) 1,2,1
 1    CONTINUE
      BRA=IB(1)
      RETURN
 2    BRA=IB(I)
      RETURN
      END
C
C---------------------------------------------------------------------------
      SUBROUTINE SLASH (XYZ)
C--------------------------------------------------------------------------
C
C-----INTERPRETS COORDINATES GIVEN IN FRACTIONAL FORM
      COMMON /SLAS/ IP(8,3)
      DIMENSION ID(10), FDE(2), IK(2), XYZ(3)
      DATA ID(1)/'0'/,ID(2)/'1'/,ID(3)/'2'/,ID(4)/'3'/,ID(5)/'4'/,ID(6)/
     1'5'/,ID(7)/'6'/,ID(8)/'7'/,ID(9)/'8'/,ID(10)/'9'/
      DATA I1HPUN/'.'/,I1HMIN/'-'/,I1HBLA/' '/
C-----NUMBER OF COLUMNS IN FORMAT FIELD OF ATOM CARD
      NFIELD=8
      DO 5 L=1,3
      IK(1)=1
      IK(2)=1
      FDE(1)=0
      FDE(2)=0
      NPOI=1
      X=1.
      IJ=1
      K=1
C-----LOOP OVER NUMBER OF FIELDS
      DO 3 I=1,NFIELD
      K=NFIELD+1-I
      DO 1 II=1,10
      IF (IP(K,L).EQ.I1HPUN) NPOI=-1
      IF (IP(K,L).EQ.I1HMIN) X=-1.
      IF (IP(K,L).EQ.I1HBLA) GO TO 3
      IF (IP(K,L).EQ.ID(II)) GO TO 2
 1    CONTINUE
      IJ=2
      GO TO 3
 2    FDE(IJ)=FDE(IJ)+10**(IK(IJ)-1)*(II-1)
      IK(IJ)=IK(IJ)+1
 3    CONTINUE
      IF (FDE(1).NE.0.)GO TO 4
      XYZ(L)=0.
      GO TO 5
 4    IF (NPOI.NE.-1) X=X*FDE(2)/FDE(1)
      EX=-IK(1)+1
      IF (NPOI.EQ.-1) X=FDE(2)*X+X*FDE(1)*10.**EX
C-----MAKE COORDINATE POSITIVE
      IF (X.LT.-1.) X=X+1.
      XYZ(L)=X
 5    CONTINUE
      RETURN
      END
C
C-----------------------------------------------------------------------
      SUBROUTINE EQVP
C-----------------------------------------------------------------------
C
C-----DECODES EQUIVALENT POSITION CARD
      COMMON /UNITS/ ICR,IPR,ILU
      COMMON /POSIT/ RNN,RDD,S1N,SZN,S3N,IPOS
      DIMENSION IPOS(45), IC(18)
      DIMENSION RNN(3), RDD(3), S1N(3), SZN(3), S3N(3)
      DATA IC(1)/'X'/,IC(2)/'Y'/,IC(3)/'Z'/,IC(4)/'-'/,IC(5)/','/,IC(6)/
     1' '/,IC(7)/'+'/,IC(8)/'/'/,IC(9)/'0'/,IC(10)/'1'/,IC(11)/'2'/,IC(1
     22)/'3'/,IC(13)/'4'/,IC(14)/'5'/,IC(15)/'6'/,IC(16)/'7'/,IC(17)/'8'
     3/,IC(18)/'9'/
      DATA I1HBLA/' '/
      DO 1 J=1,3
      RDD(J)=0
      RNN(J)=0
      S1N(J)=0
      SZN(J)=0
      S3N(J)=0
 1    CONTINUE
      K=1
      J=1
      VZ=1.
C-----LOOP OVER ALL FIELDS
      DO 13 N=1,45
      DO 2 II=1,18
      IF (IPOS(N).NE.IC(II)) GO TO 2
      M=II
      IPOS(N)=I1HBLA
      GO TO 3
 2    CONTINUE
      WRITE (IPR,15) IPOS(N)
      RNN(1)=999.9
      RETURN
 3    GO TO (7,8,9,10,11,13,13,13,4,4,4,4,4,4,4,4,4,4), M
 4    GO TO (5,6), K
 5    RNN(J)=M-9
      K=2
      GO TO 13
 6    RDD(J)=M-9
      K=1
      GO TO 13
 7    S1N(J)=VZ
      GO TO 12
 8    SZN(J)=VZ
      GO TO 12
 9    S3N(J)=VZ
      GO TO 12
 10   VZ=-1.
      GO TO 13
 11   J=J+1
      GO TO 13
 12   VZ=1.
 13   CONTINUE
      IF (J.EQ.3) GO TO 14
      WRITE (IPR,16)
      RNN(1)=999.9
 14   RETURN
C
 15   FORMAT (25H0WRONG CODE OF EQUIPOINT=,A1)
 16   FORMAT (22H0EQUIPOINT UNCOMPLETE )
      END
C
C------------------------------------------------------------------------------
      SUBROUTINE BURZL (ISYSTM,ISYMCE,IBRAVL,NG)
C------------------------------------------------------------------------------
C
C-----ROUTINE TO INTERPRET HERMANN MAUGUIN SYMBOL FOR SPACE GROUP
C-----THIS ROUTINE HAS BEEN ADAPTED FROM A PROGRAM SUPPLIED BY
C-----PROF. BURZLAFF, UNIVERSITY OF ERLANGEN, GERMANY
      COMMON /BURZ/ TS,SS
      COMMON /POSIT/ RN,RD,S1,S2,S3,NT
      COMMON /UNITS/ NRD,NPT,ILU
      INTEGER E(3,3),ZEI(3,4),SS(24,3,3),SYS
      DIMENSION NT(45), IBRA(7), NMA(3), SH(3)
      DIMENSION RN(3), RD(3), S1(3), S2(3), S3(3)
      DIMENSION TS(24,3), TE(3)
      DIMENSION ISYS(7)
      DATA ISYS(1)/7/,ISYS(2)/1/,ISYS(3)/2/,ISYS(4)/4/,ISYS(5)/6/,ISYS(6
     1)/5/,ISYS(7)/3/
      DATA IBRA(1)/'P'/,IBRA(2)/'A'/,IBRA(3)/'B'/,IBRA(4)/'C'/,IBRA(5)/'
     1F'/,IBRA(6)/'I'/,IBRA(7)/'R'/,NMA/3*0/,SH/3*0.25/
      DATA I1HMIN/'-'/,I1HSLA/'/'/,I1H1/'1'/,I1H2/'2'/,I1H3/'3'/,
     *I1H4/'4'/,I1H5/'5'/,I1H6/'6'/,I1HA/'A'/,I1HB/'B'/,I1HC/'C'/,
     *I1HD/'D'/,I1HM/'M'/,I1HN/'N'/,I1HBLA/' '/
 1    NBL=-1
      NG=1
      NS=1
      DO 2 I=1,24
      DO 2 J=1,3
      TS(I,J)=0.0
      DO 2 K=1,3
      E(J,K)=0
      SS(I,J,K)=0
 2    CONTINUE
      SS(1,1,1)=1
      SS(1,2,2)=1
      SS(1,3,3)=1
      DO 3 I=1,3
      TE(I)=0.0
      DO 3 J=1,4
 3    ZEI(I,J)=0
      DO 8 I=1,36
      KXK=NT(I)
      IF (KXK.NE.I1HBLA) GO TO 4
      NLQ=0
      IC=0
      GO TO 8
 4    IF (NBL.GE.0) GO TO 7
      DO 5 J=1,7
      NBR=J
      IF (KXK.EQ.IBRA(J)) GO TO 6
 5    CONTINUE
 6    NBL=0
      IBRAVL=KXK
      GO TO 8
 7    IF (NLQ.EQ.0) NBL=NBL+1
      IC=IC+1
      ZEI(NBL,IC)=KXK
      NLQ=1
      IF (KXK.EQ.I1HSLA) NS=0
 8    CONTINUE
      DO 9 I=1,4
      IF (ZEI(2,I).NE.I1H3) GO TO 9
      SYS=6
      GO TO 15
 9    CONTINUE
      DO 11 I=1,4
      IF (ZEI(1,I).NE.I1H3.AND.ZEI(1,I).NE.I1H6) GO TO 10
      SYS=5
      GO TO 15
 10   IF (ZEI(1,I).NE.I1H4) GO TO 11
      SYS=4
      GO TO 15
 11   CONTINUE
      IF (NBL.GT.1) GO TO 14
      IF (ZEI(1,1).NE.I1H1.AND.ZEI(1,1).NE.I1HMIN) GO TO 12
      SYS=1
      GO TO 15
 12   SYS=2
      DO 13 I=1,4
 13   ZEI(2,I)=ZEI(1,I)
      ZEI(1,1)=I1H1
      ZEI(3,1)=I1H1
 14   SYS=3
      IF (ZEI(1,1).EQ.I1H1.OR.ZEI(2,1).EQ.I1H1) SYS=2
 15   GO TO (16,17,22,46,58,68), SYS
C-----TRICLINIC
 16   IF (ZEI(1,1).EQ.I1HMIN) NS=0
      GO TO 76
C-----MONOCLINIC
 17   NG=2
      DO 18 I=1,3
 18   IF (ZEI(I,1).NE.I1H1) IND=I
      ID=1
      IF (ZEI(IND,1).EQ.I1H2) ID=-1
      DO 19 I=1,3
 19   SS(2,I,I)=SS(1,I,I)*ID
      SS(2,IND,IND)=-SS(2,IND,IND)
      DO 21 I=1,3
      IF (ZEI(I,1).EQ.I1H2.AND.ZEI(I,2).EQ.I1H1) TS(2,I)=0.5
      DO 21 J=1,4
      IF (ZEI(I,J).EQ.I1HA) TS(2,1)=0.5
      IF (ZEI(I,J).EQ.I1HB) TS(2,2)=0.5
      IF (ZEI(I,J).EQ.I1HC) TS(2,3)=0.5
      IF (ZEI(I,J).EQ.I1HN) GO TO 20
      GO TO 21
 20   K=I+1
      IF (K.GT.3) K=K-3
      TS(2,K)=0.5
      TS(2,6-K-I)=0.5
 21   CONTINUE
      GO TO 76
C-----ORTHORHOMBIC
 22   NG=4
      IC=0
      IND=1
      IF (ZEI(1,1).NE.I1H2.AND.ZEI(2,1).NE.I1H2.AND.ZEI(3,1).NE.I1H2)
     *IND=-1
      IF (IND.EQ.-1) NS=0
      DO 24 I=1,3
      ID=1
      IF (ZEI(I,1).EQ.I1H2) ID=-1
      DO 23 J=1,3
 23   SS(1+I,J,J)=SS(1,J,J)*ID*IND
 24   SS(1+I,I,I)=-SS(1+I,I,I)
      DO 28 I=1,3
      IF (ZEI(I,1).EQ.I1H2.AND.ZEI(I,2).EQ.I1H1) TS(1+I,I)=0.5
      DO 28 J=1,4
      IF (ZEI(I,J).EQ.I1HA) TS(1+I,1)=0.5
      IF (ZEI(I,J).EQ.I1HB) TS(1+I,2)=0.5
      IF (ZEI(I,J).EQ.I1HC) TS(1+I,3)=0.5
      IF (ZEI(I,J).EQ.I1HN.OR.ZEI(I,J).EQ.I1HD) GO TO 25
      GO TO 28
 25   K=I+1
      IF (K.GT.3) K=K-3
      IF (ZEI(I,J).EQ.I1HD) GO TO 26
      TS(1+I,K)=0.5
      TS(1+I,6-K-I)=0.5
      GO TO 28
 26   IC=1
      IF (NS.EQ.1) GO TO 27
      TS(1+I,K)=0.25
      TS(1+I,6-K-I)=0.25
      GO TO 28
 27   TS(1+I,1)=0.25
      TS(1+I,2)=0.25
      TS(1+I,3)=0.25
 28   CONTINUE
      IF (IC.EQ.1) GO TO 76
      IF (NS.EQ.1) GO TO 36
      DO 29 I=1,3
      K=1+I
      IF (K.GT.3) K=K-3
      TC=TS(1+K,I)+TS(1+6-I-K,I)
      IF (TC.EQ.1.0) TC=0.0
 29   TS(1+I,I)=TC
C-----SPECIAL TREATMENT OF C M M A, C M C A, I M M A
      IF (NBR.EQ.1.OR.NBR.EQ.5) GO TO 76
      MA=0
      DO 31 I=1,3
      DO 30 J=1,4
 30   IF (ZEI(I,J).EQ.I1HM) NMA(I)=1
 31   MA=MA+NMA(I)
      IF (NBR.EQ.6.AND.MA.EQ.2) GO TO 33
      IF (MA.EQ.0.OR.MA.EQ.3.OR.NBR.EQ.6) GO TO 76
      DO 32 I=1,3
      IF (NMA(NBR-1).EQ.1) GO TO 76
 32   SH(NBR-1)=0.
C-----ORIGIN SHIFT
 33   DO 35 I=1,NG
      DO 35 J=1,3
      DO 34 K=1,3
      ID=1
      IF (J.NE.K) ID=0
 34   TS(I,J)=TS(I,J)+(ID-SS(I,J,K))*SH(K)
      IF (TS(I,J).GT.1.) TS(I,J)=TS(I,J)-1.
 35   IF (TS(I,J).LT.1.0) TS(I,J)=TS(I,J)+1.
      GO TO 76
 36   IC=0
      DO 37 I=1,3
 37   IF (SS(1+I,1,1)*SS(1+I,2,2)*SS(1+I,3,3).EQ.-1) IC=1
      IF (IC.EQ.1) GO TO 41
      TC=TS(2,1)+TS(3,2)+TS(4,3)
      IF (TC.EQ.0.0) GO TO 76
      DO 40 I=1,3
      K=I+1
      IF (K.GT.3) K=K-3
      IF (TC.GT.0.5) GO TO 38
      IF (TS(1+I,I).EQ.0.0) GO TO 40
      M=I-1
      IF (M.EQ.0) M=M+3
      TS(1+M,I)=0.5
      GO TO 40
 38   IF (TC.GT.1.0) GO TO 39
      IF (TS(1+I,I).NE.0.0) GO TO 40
      L=K+1
      IF (L.GT.3) L=L-3
      TS(1+K,L)=0.5
      TS(1+L,K)=0.5
      GO TO 40
 39   TS(1+I,K)=0.5
 40   CONTINUE
      GO TO 76
 41   DO 42 I=1,3
 42   IF (SS(1+I,1,1)*SS(1+I,2,2)*SS(1+I,3,3).EQ.1) ID=I
      DO 45 I=1,3
      TC=TS(2,I)+TS(3,I)+TS(4,I)
      IF (TC.EQ.0.0.OR.TC.EQ.1.0) GO TO 45
      IF (ZEI(1,1).EQ.I1HM.AND.ZEI(2,1).EQ.I1HN.OR.ZEI(2,1).EQ.I1HM.AND.
     *ZEI(3,1).EQ.I1HN.OR.ZEI(3,1).EQ.I1HM.AND.ZEI(1,1).EQ.I1HN)GO TO 44
      DO 43 J=1,3
      IF (ID.EQ.J) GO TO 43
      IF (TS(1+J,I).EQ.0.5) GO TO 43
      TS(1+J,I)=0.5
 43   CONTINUE
      GO TO 45
 44   K=I-1
      IF (K.EQ.0) K=K+3
      TS(1+K,I)=0.5
 45   CONTINUE
      GO TO 76
C-----TETRAGONAL
 46   NG=4
      IF (NBL.EQ.3) NG=8
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,3,3)=1
      M=ZEI(1,1)
      N=ZEI(1,2)
      DO 47 I=1,3
      DO 47 J=1,3
 47   IF (M.EQ.I1HMIN) SS(2,I,J)=-SS(2,I,J)
      IF (M.EQ.I1HMIN) GO TO 50
      IF (N.EQ.I1H1) TS(2,3)=0.25
      IF (N.EQ.I1H2) TS(2,3)=0.5
      IF (N.EQ.I1H3) TS(2,3)=0.75
      IF (ZEI(1,3).EQ.I1HN.OR.(ZEI(1,4).EQ.I1HN.AND.NBL.EQ.3))
     *TS(2,1)=0.5
      IF((ZEI(1,4).EQ.I1HN.AND.NBL.EQ.1).OR.(N.EQ.I1H1.AND.NS.EQ.1.AND.
     *NBR.EQ.6)) TS(2,2)=0.5
      IF (N.EQ.I1H1.AND.NS.EQ.0.AND.NBR.EQ.6) GO TO 48
      IF(ZEI(2,2).EQ.I1H1.OR.(ZEI(1,4).NE.I1HN.AND.ZEI(2,1).EQ.I1HN.AND.
     *ZEI(3,1).EQ.I1HM)) GO TO 49
      GO TO 50
 48   TS(2,1)=0.25
      TS(2,2)=0.75
      IF (NBL.EQ.1) TS(2,1)=0.75
      IF (NBL.EQ.1) TS(2,2)=0.25
      GO TO 50
 49   TS(2,1)=0.5
      TS(2,2)=0.5
 50   SS(3,1,1)=-1
      SS(3,2,2)=-1
      SS(3,3,3)=1
      TS(3,1)=SS(2,1,2)*TS(2,2)+TS(2,1)
      TS(3,2)=SS(2,2,1)*TS(2,1)+TS(2,2)
      TS(3,3)=SS(2,3,3)*TS(2,3)+TS(2,3)
      DO 51 I=1,3
 51   IF (NBR.EQ.6.AND.TS(3,1).EQ.0.5.AND.TS(3,2).EQ.0.5.AND.TS(3,3).EQ.
     10.5) TS(3,I)=0.0
      DO 52 I=1,3
      TS(4,I)=TS(2,I)
      DO 52 J=1,3
      TS(4,I)=TS(4,I)+SS(2,I,J)*TS(3,J)
      DO 52 K=1,3
 52   SS(4,I,J)=SS(4,I,J)+SS(2,I,K)*SS(3,K,J)
      IF (NBL.EQ.1) GO TO 76
      IF (NS.EQ.0) GO TO 56
      M=ZEI(2,1)
      N=ZEI(3,1)
      IF (M.NE.I1H2.AND.N.NE.I1H2) GO TO 55
      IF (M.EQ.I1H2.AND.N.EQ.I1H2) GO TO 54
      IF (M.EQ.I1H2) GO TO 53
      IF (M.EQ.I1HC.OR.M.EQ.I1HN) TE(3)=0.5
      E(1,1)=-1
      E(2,2)=1
      E(3,3)=1
      IF (M.NE.I1HN.AND.M.NE.I1HB) GO TO 57
      TE(1)=0.5
      TE(2)=0.5
      GO TO 57
 53   E(1,1)=1
      E(2,2)=-1
      E(3,3)=-1
      IF (N.EQ.I1HC) TE(3)=0.5
      IF (N.EQ.I1HD) TE(3)=0.25
      IF (N.EQ.I1HD) TE(2)=0.5
      IF (ZEI(2,2).NE.I1H1) GO TO 57
      TE(1)=0.5
      TE(2)=0.5
      GO TO 57
 54   E(1,2)=1
      E(2,1)=1
      E(3,3)=-1
      IF (ZEI(2,2).NE.0.OR.NBR.EQ.6.OR.ZEI(1,2).EQ.0) GO TO 57
      IF (ZEI(1,2).EQ.I1H1) TE(3)=0.75
      IF (ZEI(1,2).EQ.I1H2) TE(3)=0.5
      IF (ZEI(1,2).EQ.I1H3) TE(3)=0.25
      GO TO 57
 55   M=ZEI(2,1)
      E(1,1)=-1
      E(2,2)=1
      E(3,3)=1
      IF (M.EQ.I1HC.OR.M.EQ.I1HN) TE(3)=0.5
      IF (M.EQ.I1HN.OR.M.EQ.I1HB) TE(1)=0.5
      IF (M.EQ.I1HN.OR.M.EQ.I1HB) TE(2)=0.5
      GO TO 57
 56   E(1,1)=-1
      E(2,2)=1
      E(3,3)=1
      IF (ZEI(2,1).EQ.I1HC.OR.ZEI(2,1).EQ.I1HN) TE(3)=0.5
      IF (ZEI(2,1).EQ.I1HB.OR.ZEI(2,1).EQ.I1HN) TE(2)=0.5
      IF (ZEI(2,1).EQ.I1HB.OR.ZEI(2,1).EQ.I1HN) TE(1)=0.5
      IF (ZEI(1,3).EQ.I1HN.OR.ZEI(1,4).EQ.I1HN) TE(1)=TE(1)+0.5
 57   NE=4
      GO TO 74
C-----HEXAGONAL
 58   NG=3
      M=ZEI(1,1)
      N=ZEI(1,2)
      IF (M.EQ.I1HMIN.AND.N.EQ.I1H3) NS=0
      IF (M.EQ.I1H6) GO TO 61
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,2,2)=-1
      SS(2,3,3)=1
      IF (N.EQ.I1H1) TS(2,3)=1.0/3.0
      IF (N.EQ.I1H2) TS(2,3)=2.0/3.0
      SS(3,1,1)=-1
      SS(3,2,1)=-1
      SS(3,1,2)=1
      SS(3,3,3)=1
      TS(3,3)=2.0*TS(2,3)
      IF (TS(3,3).GE.1.0) TS(3,3)=TS(3,3)-1.0
      IF (NBL.EQ.1.AND.N.NE.I1H6) GO TO 76
      IF (N.NE.I1H6) GO TO 60
      NG=NG+NG
      DO 59 I=1,3
      DO 59 J=1,3
      DO 59 K=1,3
      SS(3+I,J,K)=SS(I,J,K)
 59   SS(3+I,3,3)=-1
 60   IF (NBL.EQ.1) GO TO 76
      IF (ZEI(2,1).NE.I1HC.AND.ZEI(3,1).NE.I1HC) GO TO 63
      TS(4,3)=0.5
      TS(5,3)=0.5
      TS(6,3)=0.5
      GO TO 63
 61   NG=NG+NG
      SS(2,1,1)=1
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,3,3)=1
      IF (N.EQ.I1H1) TS(2,3)=1.0/6.0
      IF (N.EQ.I1H2) TS(2,3)=2.0/6.0
      IF (N.EQ.I1H3) TS(2,3)=3.0/6.0
      IF (N.EQ.I1H4) TS(2,3)=4.0/6.0
      IF (N.EQ.I1H5) TS(2,3)=5.0/6.0
      DO 62 I=1,4
      DO 62 J=1,3
      TS(2+I,J)=TS(2,J)
      DO 62 K=1,3
      TS(2+I,J)=TS(2+I,J)+SS(2,J,K)*TS(1+I,K)
      IF (TS(2+I,J).GT.1.0) TS(2+I,J)=TS(2+I,J)-1.0
      DO 62 L=1,3
 62   SS(2+I,J,K)=SS(2+I,J,K)+SS(2,J,L)*SS(1+I,L,K)
      IF (NBL.EQ.1) GO TO 76
 63   NG=NG+NG
      M=ZEI(2,1)
      N=ZEI(3,1)
      IF (M.EQ.I1H1) GO TO 65
      IF (M.EQ.I1H2) GO TO 64
      E(1,2)=-1
      E(2,1)=-1
      E(3,3)=1
      IF (M.EQ.I1HC) TE(3)=0.5
      GO TO 67
 64   E(1,2)=1
      E(2,1)=1
      E(3,3)=-1
      TE(3)=2.0*TS(2,3)
C-----GROUP P 31 I 2 AND P 32 I 2
      IF (ZEI(1,1).EQ.I1H3.AND.(ZEI(1,2).EQ.I1H1.OR.ZEI(1,2).EQ.I1H2))
     *TE(3)=0.
      GO TO 67
 65   IF (N.EQ.I1H2) GO TO 66
      E(1,2)=1
      E(2,1)=1
      E(3,3)=1
      IF (N.EQ.I1HC) TE(3)=0.5
      GO TO 67
 66   E(1,2)=-1
      E(2,1)=-1
      E(3,3)=-1
      TE(3)=2.0*TS(2,3)
      IF (TE(3).GT.1.0) TE(3)=TE(3)-1.0
 67   NE=6
      IF (ZEI(1,1).EQ.I1H3.OR.(ZEI(1,2).EQ.I1H3.AND.ZEI(1,1)
     *.EQ.I1HMIN)) NE=3
      GO TO 74
C-----CUBIC
 68   NG=12
      IF (NBL.EQ.3) NG=24
      IF (ZEI(1,1).NE.I1H2.AND.ZEI(1,1).NE.I1H4.AND.ZEI(1,1).NE.I1HMIN)
     *NS=0
      DO 69 I=1,3
      DO 69 J=1,3
      SS(1+I,J,J)=1
      IF (I.EQ.J) GO TO 69
      SS(1+I,J,J)=-1
      IF (ZEI(1,1).EQ.I1HN) TS(1+I,J)=0.5
      IF (ZEI(1,1).EQ.I1HD) TS(1+I,J)=0.25
 69   CONTINUE
      IF (ZEI(1,1).NE.I1HA.AND.ZEI(3,1).NE.I1HD.AND.ZEI(1,2).NE.I1H3
     1.AND.ZEI(1,2).NE.I1H1.OR.NBR.EQ.5) GO TO 71
      DO 70 I=1,3
      TS(1+I,I)=0.5
      K=I+1
      IF (K.EQ.4) K=1
 70   TS(1+I,K)=0.5
 71   DO 72 I=1,4
      DO 72 J=1,3
      DO 72 K=1,3
      L=J+1
      IF (L.EQ.4) L=1
      M=J-1
      IF (M.EQ.0) M=3
      SS(4+I,J,K)=SS(I,L,K)
      SS(8+I,J,K)=SS(I,M,K)
      TS(4+I,J)=TS(I,L)
 72   TS(8+I,J)=TS(I,M)
      IF (NG.EQ.12) GO TO 76
      NE=12
      E(1,2)=1
      E(2,1)=1
      E(3,3)=1
      IF (ZEI(3,1).EQ.I1H2) E(3,3)=-1
      IF (ZEI(3,1).EQ.I1HC) TE(3)=0.5
      DO 73 I=1,3
      IF (ZEI(3,1).EQ.I1HN.OR.ZEI(1,2).EQ.I1H2) TE(I)=0.5
 73   IF (ZEI(3,1).EQ.I1HD.OR.ZEI(1,2).EQ.I1H1.OR.ZEI(1,2).EQ.I1H3)
     *TE(I)=0.25
      IF (ZEI(1,2).EQ.I1H1.AND.NBR.EQ.1) TE(1)=0.75
      IF ((ZEI(1,2).NE.I1H1.OR.NBR.NE.6).AND.(ZEI(1,2).NE.I1H3.OR.
     *NBR.NE.1)) GO TO 74
      TE(2)=0.75
      TE(3)=0.75
 74   DO 75 I=1,NE
      DO 75 J=1,3
      TS(NE+I,J)=TE(J)
      DO 75 K=1,3
      TS(NE+I,J)=TS(NE+I,J)+E(J,K)*TS(I,K)
      DO 75 L=1,3
 75   SS(NE+I,J,K)=SS(NE+I,J,K)+E(J,L)*SS(I,L,K)
 76   DO 81 I=1,NG
      DO 81 J=1,3
 77   IF (TS(I,J).GE.1.0) GO TO 78
      GO TO 79
 78   TS(I,J)=TS(I,J)-1.0
      GO TO 77
 79   IF (TS(I,J).LT.0.0) GO TO 80
      GO TO 81
 80   TS(I,J)=TS(I,J)+1.0
      GO TO 79
 81   CONTINUE
      ISYSTM=ISYS(SYS)
      IF (NS.EQ.0) ISYMCE=1
      IF (NS.EQ.1) ISYMCE=0
      DO 82 I=1,NG
 82   CONTINUE
      RETURN
      END
C
C------------------------------------------------------------------------------
      SUBROUTINE EXTINC (ISYMCE,NS)
C------------------------------------------------------------------------------
C
C-----FINDS EXTINCTIONS, LAUE GROUP AND HEXAGONAL SYMMETRY INDICATOR
      COMMON /EXTI/ IHOO,IOKO,IOOL,IHKO,IHOL,IOKL,IHHL,ILAU,ITRIG
      COMMON /EQUI/ TS,FS
      COMMON /UNITS/ NRD,NPT,ILU
      DIMENSION TS(3,24), FS(3,3,24)
      ILAU=1
      Q1=1./3.
      Q2=1./6.
      Q3=2./3.
      Q4=5./6.
      DO 2 I=1,NS
      POIN=0.
      R=TS(1,I)
      S=TS(2,I)
      T=TS(3,I)
      X=FS(1,1,I)*10.+FS(2,1,I)*50.+FS(3,1,I)*100.
      Y=FS(1,2,I)*10.+FS(2,2,I)*50.+FS(3,2,I)*100.
      Z=FS(1,3,I)*10.+FS(2,3,I)*50.+FS(3,3,I)*100.
      XO=ABS(X)
      YO=ABS(Y)
      ZO=ABS(Z)
      IF ((R.EQ..5).AND.(XO.EQ.10.)) IHOO=2
      IF ((S.EQ..5).AND.(YO.EQ.50.)) IOKO=2
      IF (IOOL.GT.3) GO TO 1
      IF ((T.EQ..5).AND.(ZO.EQ.100.)) IOOL=2
      IF ((T.EQ.Q2).OR.(T.EQ.Q4)) IOOL=6
      IF ((T.EQ.Q1).OR.(T.EQ.Q3)) IOOL=3
      IF ((T.EQ..25).OR.(T.EQ..75)) IOOL=4
 1    IF ((X.EQ.50.).AND.(Y.EQ.10.)) ILAU=2
      IF ((X.EQ.-50.00).AND.(Y.EQ.-10.00)) ILAU=2
      IF ((X.EQ.-40.).AND.(Y.EQ.10.).AND.(Z.EQ.100.)) ITRIG=6
      IF ((X.EQ.40.00).AND.(Y.EQ.-10.00).AND.(Z.EQ.-100.00)) ITRIG=6
      IF (((S.EQ..25).OR.(S.EQ..75)).AND.(YO.EQ.50.)) IOKO=4
      IF (((R.EQ..25).OR.(R.EQ..75)).AND.(XO.EQ.10.)) IHOO=4
      X=X+R
      Y=Y+S
      Z=Z+T
      IF ((X.EQ.10.5).AND.(Y.EQ.50.5)) IHKO=2
      IF ((X.EQ.10.0).AND.(Y.EQ.50.5)) IHKO=3
      IF ((X.EQ.10.25).AND.(Y.EQ.50.25)) IHKO=4
      IF ((X.EQ.10.75).AND.(Y.EQ.50.75)) IHKO=4
      IF ((X.EQ.10.50).AND.(Y.EQ.50.00)) IHKO=5
      IF ((Y.EQ.50.50).AND.(Z.EQ.100.50)) IOKL=2
      IF ((Y.EQ.50.00).AND.(Z.EQ.100.50)) IOKL=3
      IF ((Y.EQ.50.25).AND.(Z.EQ.100.25)) IOKL=4
      IF ((Y.EQ.50.75).AND.(Z.EQ.100.75)) IOKL=4
      IF ((Y.EQ.50.50).AND.(Z.EQ.100.00)) IOKL=5
      IF ((X.EQ.10.5).AND.(Z.EQ.100.50)) IHOL=2
      IF ((X.EQ.10.0).AND.(Z.EQ.100.50)) IHOL=3
      IF ((X.EQ.10.25).AND.(Z.EQ.100.25)) IHOL=4
      IF ((X.EQ.10.75).AND.(Z.EQ.100.75)) IHOL=4
      IF ((X.EQ.10.5).AND.(Z.EQ.100.0)) IHOL=5
      IF ((X.EQ.50.50).AND.(Y.EQ.10.5).AND.(Z.EQ.100.50)) IHHL=2
      IF ((X.EQ.50.00).AND.(Y.EQ.10.0).AND.(Z.EQ.100.50)) IHHL=2
      IF ((X.EQ.50.00).AND.(Y.EQ.10.00).AND.(Z.EQ.100.50)) IHHL=2
      IF ((X.EQ.50.00).AND.(Y.EQ.10.5).AND.(Z.EQ.100.25)) IHHL=3
      IF ((X.EQ.50.00).AND.(Y.EQ.10.5).AND.(Z.EQ.100.75)) IHHL=3
      IF ((X.EQ.50.75).AND.(Y.EQ.10.75).AND.(Z.EQ.100.75)) IHHL=3
      IF ((X.EQ.50.75).AND.(Y.EQ.10.75).AND.(Z.EQ.100.25)) IHHL=3
      IF ((X.EQ.50.25).AND.(Y.EQ.10.25).AND.(Z.EQ.100.25)) IHHL=3
C-----CHECK CENTROSYMMETRIC POSITION
      IF (ISYMCE.EQ.0) GO TO 2
      IF (POIN.EQ.-1.) GO TO 2
      POIN=-1.
      X=-X+R
      Y=-Y+S
      Z=-Z+T
      IF (R.NE.0.) R=1.-R
      IF (S.NE.0.) S=1.-S
      IF (T.NE.0.) T=1.-T
      GO TO 1
 2    CONTINUE
      RETURN
      END
C
C--------------------------------------------------------------------------
      SUBROUTINE MULTF
C--------------------------------------------------------------------------
C
C-----CALCULATES MULTIPLICITIES OF SPECIAL POSITIONS
      DIMENSION COMPND(19), IELMT(8), X(50,8), Y(50,8), Z(50,8), FOCCU(5
     10,8), FMULT(50,8), FNEUT(8), NA(8), TS(3,24), FS(3,3,24), BTEMP(50
     2,8), DELFR(8), DELFI(8), B1(3,9), TSB(3), XYZ(3), XYZ1(3)
      COMMON /INPUT/ COMPND,IELMT,X,Y,Z,FOCCU,FMULT,FNEUT,A,B,C,ALPHA,BE
     1TA,GAMMA,SYMSY,SYMBR,ISYMCE,NCOMPO,NA,SYMWL,WL,SL,SH,NORM,IMAGE,SY
     2MLP,AGUIN,BGUIN,BTEMP,DELFR,DELFI,IANO,NS,IBRAVL
      COMMON /EQUI/ TS,FS
      COMMON /UNITS/ ICR,IPR,ILU
      DATA B1(1,1)/0./,B1(2,1)/0./,B1(3,1)/0./,B1(1,2)/0.5/,B1(2,2)/0.5/
     1,B1(3,2)/0.5/,B1(1,3)/0.66667/,B1(2,3)/0.33333/,B1(3,3)/0.33333/,B
     21(1,4)/0.5/,B1(2,4)/0.5/,B1(3,4)/0./,B1(1,5)/0./,B1(2,5)/0.5/,B1(3
     3,5)/0.5/,B1(1,6)/0.5/,B1(2,6)/0./,B1(3,6)/0.5/,B1(1,7)/0.5/,B1(2,7
     4)/0.5/,B1(3,7)/0.0/,B1(1,8)/0.33333/,B1(2,8)/0.66667/,B1(3,8)/0.66
     5667/
      NBRA=1
      IF (IBRAVL.GT.1) NBRA=2
      IF (IBRAVL.EQ.3) NBRA=3
      IF (IBRAVL.EQ.4) NBRA=4
C-----LOOP OVER ATOMKINDS
      DO 7 IC=1,NCOMPO
      NATOM=NA(IC)
C-----LOOP OVER ATOMS OF ONE KIND
      DO 6 IA=1,NATOM
      XYZ1(1)=X(IA,IC)
      XYZ1(2)=Y(IA,IC)
      XYZ1(3)=Z(IA,IC)
C-----MAKE COORDINATES POSITIVE
      DO 1 I=1,3
 1    IF (XYZ1(I).LT.0.) XYZ1(I)=XYZ1(I)+1.
      FMULT(IA,IC)=0.
C-----LOOP OVER EQUIVALENT POSITIONS
      DO 4 J=1,NS
C-----LOOP OVER BRAVAIS LATTICE POINTS
      DO 4 NB=1,NBRA
      ANTI=1.
 2    DIF=0.
C-----CALCULATE ATOM COORDINATES
      DO 3 I=1,3
      XYZ(I)=ANTI*(TS(I,J)+FS(1,I,J)*XYZ1(1)+FS(2,I,J)*XYZ1(2)+FS(3,I,J)
     1*XYZ1(3)) +0.00001
      IF (NB.EQ.1) TSB(I)=B1(I,1)
      IF (NB.EQ.2) TSB(I)=B1(I,IBRAVL)
      IF (NB.EQ.4) TSB(I)=B1(I,6)
      IF ((NB.EQ.3).AND.(IBRAVL.EQ.3)) TSB(I)=B1(I,8)
      IF ((NB.EQ.3).AND.(IBRAVL.EQ.4)) TSB(I)=B1(I,5)
C-----ADD BRAVAIS LATTICE VECTORS
      XYZ(I)=XYZ(I)+TSB(I)
C-----MAKE COORDINATES POSITIVE AND LESS THAN 1.
      IF (XYZ(I).GE.1.) XYZ(I)=XYZ(I)-1.
      IF (XYZ(I).LT.-1.) XYZ(I)=XYZ(I)+1.
      IF (XYZ(I).LT.0.) XYZ(I)=XYZ(I)+1.
C-----CALCULATE NUMBER FMULT OF COINCIDING ATOMS
 3    CONTINUE
      DIF=XYZ(1)-XYZ1(1)
      DIF=ABS(DIF)
      DIF1=XYZ(2)-XYZ1(2)
      DIF1=ABS(DIF1)
      DIF=DIF+DIF1
      DIF1=XYZ(3)-XYZ1(3)
      DIF1=ABS(DIF1)
      DIF=DIF+DIF1
      IF (DIF.LT..001) FMULT(IA,IC)=FMULT(IA,IC)+1.
C-----CHECK CENTROSYMMETRICALLY RELATED ATOMS
      IF (ISYMCE.NE.1) GO TO 4
      IF (ANTI.EQ.-1.) GO TO 4
      ANTI=-1.
      GO TO 2
 4    CONTINUE
      IF (FMULT(IA,IC).NE.0.) GO TO 5
      A=-1.
      WRITE (IPR,8) IA,IC
 5    FMULT(IA,IC)=1./FMULT(IA,IC)
 6    CONTINUE
 7    CONTINUE
      RETURN
C
 8    FORMAT (22H WRONG MULTIPLICITY OF,I5,16H TH ATOM OF TYPE,I5,43H CH
     1ECK COORDINATES AND EQUIVALENT POSITIONS)
      END
C
C----------------------------------------------------------------------------
      SUBROUTINE FSC (ELEMT,MN)
C----------------------------------------------------------------------------
C
C-----RETRIEVES THE COEFFICIENTS FOR THE ATOMIC SCATTERING FUNCTIONS
C-----COMPILED BY CROMER AND MANN   FOR THE MN TH ELEMENT ELEMT
C-----AND STORES THEM IN COMMON SCAT
      DIMENSION A(1926)
      DIMENSION FA(4,8), FB(4,8), FC(8)
      COMMON /SK/ A
      COMMON /SCAT/ FA,FB,FC
      INTEGER ELEMT
      M=MN
C-----RETRIEVE SEQUENCE NUMBER OF ATOM TYPE
      CALL SYMBF (ELEMT,IELMT)
      IS=IELMT*9-8
      IF ((IS.GT.0).AND.(IS.LT.1944)) GO TO 1
      FC(M)=999.9
      RETURN
 1    DO 2 I=1,4
      FA(I,M)=A(IS)
      FB(I,M)=A(IS+1)
      IS=IS+2
 2    CONTINUE
      FC(M)=A(IS)
      RETURN
      END
C
C------------------------------------------------------------------------
      SUBROUTINE SYMBF (ASYMB,IELMT)
C------------------------------------------------------------------------
C
C-----FINDS THE SEQUENCE NUMBER IELMT OF ELEMENT ASYMB AMONG ELEMENTS
C-----FOR WHICH SCATTERING CURVES EXIST IN ROUTINES CONF1 - CONF6
      COMMON /UNITS/ ICR,IPR,ILU
      DIMENSION S(214)
      INTEGER S,ASYMB
      DATA S(1)/'H   '/,S(2)/'H.  '/,S(3)/'H1- '/,S(4)/'HE  '/,S(5)/'LI
     1 '/,S(6)/'LI1+'/,S(7)/'BE  '/,S(8)/'BE2+'/,S(9)/'B   '/,S(10)/'C
     2 '/,S(11)/'C.  '/,S(12)/'N   '/,S(13)/'O   '/,S(14)/'O1- '/,S(15)/
     3'F   '/,S(16)/'F1- '/,S(17)/'NE  '/,S(18)/'NA  '/,S(19)/'NA1+'/,S(
     420)/'MG  '/,S(21)/'MG2+'/,S(22)/'AL  '/,S(23)/'AL3+'/,S(24)/'SI  '
     5/,S(25)/'SI. '/,S(26)/'SI4+'/,S(27)/'S   '/,S(28)/'P   '/,S(29)/'C
     6L  '/,S(30)/'CL1-'/,S(31)/'AR  '/,S(32)/'K   '/,S(33)/'K1+ '/,S(34
     7)/'CA  '/,S(35)/'CA2+'/,S(36)/'SC  '/,S(37)/'SC3+'/,S(38)/'TI  '/,
     8S(39)/'TI2+'/,S(40)/'TI3+'/
      DATA S(41)/'TI4+'/,S(42)/'V   '/,S(43)/'V2+ '/,S(44)/'V3+ '/,S(45)
     1/'V5+ '/,S(46)/'CR  '/,S(47)/'CR2+'/,S(48)/'CR3+'/,S(49)/'MN  '/,S
     2(50)/'MN2+'/,S(51)/'MN3+'/,S(52)/'MN4+'/,S(53)/'FE  '/,S(54)/'FE+2
     3'/,S(55)/'FE3+'/,S(56)/'CO  '/,S(57)/'CO2+'/,S(58)/'CO3+'/,S(59)/'
     4NI  '/,S(60)/'NI2+'/,S(61)/'NI3+'/,S(62)/'CU  '/,S(63)/'CU1+'/,S(6
     54)/'CU2+'/,S(65)/'ZN  '/,S(66)/'ZN2+'/,S(67)/'GA  '/,S(68)/'GA3+'/
     6,S(69)/'GE  '/,S(70)/'GE4+'/,S(71)/'AS  '/,S(72)/'SE  '/,S(73)/'BR
     7  '/,S(74)/'BR1-'/,S(75)/'KR  '/,S(76)/'RB  '/,S(77)/'RB1+'/,S(78)
     8/'SR  '/,S(79)/'SR2+'/,S(80)/'Y   '/
      DATA S(81)/'Y3+ '/,S(82)/'ZR  '/,S(83)/'ZR4+'/,S(84)/'NB  '/,S(85)
     1/'NB3+'/,S(86)/'NB5+'/,S(87)/'MO  '/,S(88)/'MO3+'/,S(89)/'MO5+'/,S
     2(90)/'MO6+'/,S(91)/'TC  '/,S(92)/'RU  '/,S(93)/'RU3+'/,S(94)/'RU+4
     3'/,S(95)/'RH  '/,S(96)/'RH3+'/,S(97)/'RH4+'/,S(98)/'PD  '/,S(99)/'
     4PD2+'/,S(100)/'PD4+'/,S(101)/'AG  '/,S(102)/'AG1+'/,S(103)/'AG2+'/
     5,S(104)/'CD  '/,S(105)/'CD2+'/,S(106)/'IN  '/,S(107)/'IN3+'/,S(108
     6)/'SN  '/,S(109)/'SN2+'/,S(110)/'SN4+'/,S(111)/'SB  '/,S(112)/'SB3
     7+'/,S(113)/'SB5+'/,S(114)/'TE  '/,S(115)/'I   '/,S(116)/'I1- '/,S(
     8117)/'XE  '/,S(118)/'CS  '/,S(119)/'CS1+'/,S(120)/'BA  '/
      DATA S(121)/'BA2+'/,S(122)/'LA  '/,S(123)/'LA3+'/,S(124)/'CE  '/,S
     1(125)/'CE3+'/,S(126)/'CE4+'/,S(127)/'PR  '/,S(128)/'PR3+'/,S(129)/
     2'PR4+'/,S(130)/'ND  '/,S(131)/'ND3+'/,S(132)/'PM  '/,S(133)/'PM3+'
     3/,S(134)/'SM  '/,S(135)/'SM3+'/,S(136)/'EU  '/,S(137)/'EU2+'/,S(13
     48)/'EU3+'/,S(139)/'GD  '/,S(140)/'GD3+'/,S(141)/'TB  '/,S(142)/'TB
     53+'/,S(143)/'DY  '/,S(144)/'DY3+'/,S(145)/'HO  '/,S(146)/'HO3+'/,S
     6(147)/'ER  '/,S(148)/'ER3+'/,S(149)/'TM  '/,S(150)/'TM3+'/,S(151)/
     7'YB  '/,S(152)/'YB2+'/,S(153)/'YB3+'/,S(154)/'LU  '/,S(155)/'LU3+'
     8/,S(156)/'HF  '/,S(157)/'HF4+'/,S(158)/'TA  '/,S(159)/'TA5+'/,S(16
     90)/'W   '/
      DATA S(161)/'W6+ '/,S(162)/'RE  '/,S(163)/'OS  '/,S(164)/'OS4+'/,S
     1(165)/'IR  '/,S(166)/'IR3+'/,S(167)/'IR4+'/,S(168)/'PT  '/,S(169)/
     2'PT2+'/,S(170)/'PT4+'/,S(171)/'AU  '/,S(172)/'AU1+'/,S(173)/'AU3+'
     3/,S(174)/'HG  '/,S(175)/'HG1+'/,S(176)/'HG2+'/,S(177)/'TL  '/,S(17
     48)/'TL1+'/,S(179)/'TL3+'/,S(180)/'PB  '/,S(181)/'PB2+'/,S(182)/'PB
     54+'/,S(183)/'BI  '/,S(184)/'BI3+'/,S(185)/'BI5+'/,S(186)/'PO  '/,S
     6(187)/'AT  '/,S(188)/'RN  '/,S(189)/'FR  '/,S(190)/'RA  '/,S(191)/
     7'RA2+'/,S(192)/'AC  '/,S(193)/'AC3+'/,S(194)/'TH  '/,S(195)/'TH4+'
     8/,S(196)/'PA  '/,S(197)/'U   '/,S(198)/'U3+ '/,S(199)/'U4+ '/,S(20
     90)/'U6+ '/
      DATA S(201)/'NP  '/,S(202)/'NP3+'/,S(203)/'NP4+'/,S(204)/'NP6+'/,S
     1(205)/'PU  '/,S(206)/'PU3+'/,S(207)/'PU4+'/,S(208)/'PU6+'/,S(209)/
     2'AM  '/,S(210)/'CM  '/,S(211)/'BK  '/,S(212)/'CF  '/,
     3S(213)/'O2-.'/,S(214)/'    '/
      DO 1 I=1,214
      IF (ASYMB-S(I)) 1,2,1
 1    CONTINUE
      WRITE (IPR,3) ASYMB
      I=0
 2    IELMT=I
      RETURN
C
 3    FORMAT (46H NO SCATTERING FACTOR TABLES EXIST FOR ELEMENT,A4)
      END
C
C-----------------------------------------------------------------------------
      BLOCK DATA
C-----------------------------------------------------------------------------
C
C-----CONTAINS FIRST    PART OF SCATTERING FACTOR CONSTANTS BY
C-----CROMER AND MANN   TAKEN FROM INTERNAT TABLES VOL 4
      REAL I,J,L,M,N,K
      COMMON /SK/ AA(1926)
      COMMON /WAVEL/ Z2(20)
      EQUIVALENCE (AA(1),A(1)), (AA(73),B(1)), (AA(145),C(1)), (AA(217),
     1D(1)), (AA(289),E(1))
      EQUIVALENCE (AA(433),G(1)), (AA(505),H(1)), (AA(577),I(1)), (AA(64
     19),J(1)), (AA(361),F(1))
      EQUIVALENCE (AA(865),M(1)), (AA(937),N(1)), (AA(1009),O(1)), (AA(7
     121),K(1)), (AA(793),L(1))
      EQUIVALENCE (AA(1297),S(1)), (AA(1369),T(1)), (AA(1081),P(1)), (AA
     1(1153),Q(1)), (AA(1225),R(1))
      EQUIVALENCE (AA(1729),Y(1)), (AA(1441),U(1)), (AA(1513),V(1)), (AA
     1(1585),W(1)), (AA(1657),X(1))
      EQUIVALENCE (AA(1801),Z(1)), (AA(1873),Z1(1))
      DIMENSION A(72), B(72), C(72), D(72), E(72)
      DIMENSION F(72), G(72), H(72), I(72), J(72)
      DIMENSION M(72), N(72), O(72), K(72), L(72)
      DIMENSION S(72), T(72), P(72), Q(72), R(72)
      DIMENSION U(72), V(72), W(72), X(72), Y(72)
      DIMENSION Z(72), Z1(54)
      DATA A(1)/.493002/,A(2)/10.5109/,A(3)/.322912/,A(4)/26.1257/,A(5)/
     1.140191/,A(6)/3.14236/,A(7)/.040810/,A(8)/57.7997/,A(9)/.003038/,A
     2(10)/.489918/,A(11)/20.6593/,A(12)/.262003/,A(13)/7.74039/,A(14)/.
     3196767/,A(15)/49.5519/,A(16)/.049879/,A(17)/2.20159/,A(18)/.001305
     4/,A(19)/.897661/,A(20)/53.1368/,A(21)/.565616/,A(22)/15.1870/,A(23
     5)/.415815/,A(24)/186.576/,A(25)/.116973/,A(26)/3.56709/,A(27)/.002
     6389/,A(28)/.8734/,A(29)/9.1037/,A(30)/.6309/,A(31)/3.3568/,A(32)/.
     73112/,A(33)/22.9276/,A(34)/.1780/,A(35)/.9821/,A(36)/.0064/,A(37)/
     81.1282/,A(38)/3.9546/,A(39)/.7508/,A(40)/1.0524/,A(41)/.6175/,A(42
     9)/85.3905/,A(43)/.4653/,A(44)/168.261/,A(45)/.0377/,A(46)/.6968/,A
     $(47)/4.6237/,A(48)/.7888/,A(49)/1.9557/,A(50)/.3414/,A(51)/.6316/,
     $A(52)/.1563/,A(53)/10.0953/,A(54)/.0167/,A(55)/1.5919/,A(56)/43.64
     $27/,A(57)/1.1278/,A(58)/1.8623/,A(59)/.5391/,A(60)/103.483/,A(61)/
     $.7029/,A(62)/.5420/,A(63)/.0385/,A(64)/6.2603/,A(65)/.0027/,A(66)/
     $.8849/,A(67)/.8313/,A(68)/.7993/,A(69)/2.2758/,A(70)/.1647/,A(71)/
     $5.1146/,A(72)/-6.1092/
      DATA B(1)/2.0545/,B(2)/23.2185/,B(3)/1.3326/,B(4)/1.0210/,B(5)/1.0
     1979/,B(6)/60.3498/,B(7)/.7068/,B(8)/.1403/,B(9)/-.1932/,B(10)/2.31
     200/,B(11)/20.8439/,B(12)/1.0200/,B(13)/10.2075/,B(14)/1.5886/,B(15
     3)/.5687/,B(16)/.8650/,B(17)/51.6512/,B(18)/.2156/,B(19)/2.26069/,B
     4(20)/22.6907/,B(21)/1.56165/,B(22)/.656665/,B(23)/1.05075/,B(24)/9
     5.75618/,B(25)/.839259/,B(26)/55.5949/,B(27)/.286977/,B(28)/12.2126
     6/,B(29)/.0057/,B(30)/3.1322/,B(31)/9.8933/,B(32)/2.0125/,B(33)/28.
     79975/,B(34)/1.1663/,B(35)/.5826/,B(36)/-11.529/,B(37)/3.0485/,B(38
     8)/13.2771/,B(39)/2.2868/,B(40)/5.7011/,B(41)/1.5463/,B(42)/.3239/,
     9B(43)/.8670/,B(44)/32.9089/,B(45)/.2508/,B(46)/4.19160/,B(47)/12.8
     $573/,B(48)/1.63969/,B(49)/4.17236/,B(50)/1.52673/,B(51)/47.0179/,B
     $(52)/-20.307/,B(53)/-.01404/,B(54)/21.9412/,B(55)/3.5392/,B(56)/10
     $.2825/,B(57)/2.6412/,B(58)/4.2944/,B(59)/1.5170/,B(60)/.2615/,B(61
     $)/1.0243/,B(62)/26.1476/,B(63)/.2776/,B(64)/3.63220/,B(65)/5.27756
     $/,B(66)/3.51057/,B(67)/14.7353/,B(68)/1.26064/,B(69)/.442258/,B(70
     $)/.940706/,B(71)/47.3437/,B(72)/.653396/
      DATA C(1)/3.9553/,C(2)/8.4042/,C(3)/3.1125/,C(4)/3.4262/,C(5)/1.45
     146/,C(6)/.2306/,C(7)/1.1251/,C(8)/21.7184/,C(9)/.3515/,C(10)/4.762
     26/,C(11)/3.2850/,C(12)/3.1736/,C(13)/8.8422/,C(14)/1.2674/,C(15)/.
     33136/,C(16)/1.1128/,C(17)/129.424/,C(18)/.6760/,C(19)/3.2565/,C(20
     4)/2.6671/,C(21)/3.9362/,C(22)/6.1153/,C(23)/1.3998/,C(24)/.2001/,C
     5(25)/1.0032/,C(26)/14.0390/,C(27)/.4040/,C(28)/5.4204/,C(29)/2.827
     65/,C(30)/2.1735/,C(31)/79.2611/,C(32)/1.2269/,C(33)/.3808/,C(34)/2
     7.3073/,C(35)/7.1937/,C(36)/.8584/,C(37)/3.4988/,C(38)/2.1676/,C(39
     8)/3.8378/,C(40)/4.7542/,C(41)/1.3284/,C(42)/.1850/,C(43)/.8497/,C(
     944)/10.1411/,C(45)/.4853/,C(46)/6.4202/,C(47)/3.0387/,C(48)/1.9002
     $/,C(49)/.7426/,C(50)/1.5936/,C(51)/31.5472/,C(52)/1.9646/,C(53)/85
     $.0886/,C(54)/1.1151/,C(55)/4.17448/,C(56)/1.93816/,C(57)/3.38760/,
     $C(58)/4.14553/,C(59)/1.20296/,C(60)/.228753/,C(61)/.528137/,C(62)/
     $8.28524/,C(63)/.706786/,C(64)/6.2915/,C(65)/2.4386/,C(66)/3.0353/,
     $C(67)/32.3337/,C(68)/1.9891/,C(69)/.6785/,C(70)/1.5410/,C(71)/81.6
     $937/,C(72)/1.1407/
      DATA D(1)/5.66269/,D(2)/2.66520/,D(3)/3.07164/,D(4)/38.6634/,D(5)/
     12.62446/,D(6)/.916946/,D(7)/1.39320/,D(8)/93.5458/,D(9)/1.24707/,D
     2(10)/4.43918/,D(11)/1.64167/,D(12)/3.20345/,D(13)/3.43757/,D(14)/1
     3.19453/,D(15)/.214900/,D(16)/.416530/,D(17)/6.65365/,D(18)/.746297
     4/,D(19)/6.9053/,D(20)/1.4679/,D(21)/5.2034/,D(22)/22.2151/,D(23)/1
     5.4379/,D(24)/.2536/,D(25)/1.5863/,D(26)/56.1720/,D(27)/.8669/,D(28
     6)/6.4345/,D(29)/1.9067/,D(30)/4.1791/,D(31)/27.1570/,D(32)/1.7800/
     7,D(33)/.5260/,D(34)/1.4908/,D(35)/68.1645/,D(36)/1.1149/,D(37)/11.
     84604/,D(38)/.0104/,D(39)/7.1964/,D(40)/1.1662/,D(41)/6.2556/,D(42)
     9/18.5194/,D(43)/1.6455/,D(44)/47.7784/,D(45)/-9.5574/,D(46)/18.291
     $5/,D(47)/.0066/,D(48)/7.2084/,D(49)/1.1717/,D(50)/6.5337/,D(51)/19
     $.5424/,D(52)/2.3386/,D(53)/60.4486/,D(54)/-16.378/,D(55)/7.4845/,D
     $(56)/.9072/,D(57)/6.7723/,D(58)/14.8407/,D(59)/.6539/,D(60)/43.898
     $3/,D(61)/1.6442/,D(62)/33.3929/,D(63)/1.4445/,D(64)/8.2186/,D(65)/
     $12.7949/,D(66)/7.4398/,D(67)/.7748/,D(68)/1.0519/,D(69)/213.187/,D
     $(70)/.8659/,D(71)/41.6841/,D(72)/1.4228/
      DATA E(1)/7.9578/,E(2)/12.6331/,E(3)/7.4917/,E(4)/.7674/,E(5)/6.35
     190/,E(6)/-.0020/,E(7)/1.1915/,E(8)/31.9128/,E(9)/-4.9978/,E(10)/8.
     26266/,E(11)/10.4421/,E(12)/7.3873/,E(13)/.6599/,E(14)/1.5899/,E(15
     3)/85.7484/,E(16)/1.0211/,E(17)/178.437/,E(18)/1.3751/,E(19)/15.634
     48/,E(20)/-.0074/,E(21)/7.9518/,E(22)/.6089/,E(23)/8.4372/,E(24)/10
     5.3116/,E(25)/.8537/,E(26)/25.9905/,E(27)/-14.875/,E(28)/9.1890/,E(
     629)/9.0213/,E(30)/7.3679/,E(31)/.5729/,E(32)/1.6409/,E(33)/136.108
     7/,E(34)/1.4680/,E(35)/51.3531/,E(36)/1.3329/,E(37)/13.4008/,E(38)/
     8.298540/,E(39)/8.02730/,E(40)/7.96290/,E(41)/1.65943/,E(42)/-.2860
     94/,E(43)/1.57936/,E(44)/16.0662/,E(45)/-6.6667/,E(46)/9.7595/,E(47
     $)/7.8508/,E(48)/7.3558/,E(49)/.5000/,E(50)/1.6991/,E(51)/35.6338/,
     $E(52)/1.9021/,E(53)/116.105/,E(54)/1.2807/,E(55)/9.11423/,E(56)/7.
     $52430/,E(57)/7.62174/,E(58)/.457585/,E(59)/2.27930/,E(60)/19.5361/
     $,E(61)/.087899/,E(62)/61.6558/,E(63)/.897155/,E(64)/17.7344/,E(65)
     $/.220610/,E(66)/8.73816/,E(67)/7.04716/,E(68)/5.25691/,E(69)/-.157
     $62/,E(70)/1.92134/,E(71)/15.9768/,E(72)/-14.652/
C-----CONTAINS SECOND PART OF SCATTERING FACTOR CONSTANTS BY
C-----CROMER AND MANN  TAKEN FROM INTERNAT TABLES VOL 4
      DATA F(1)/19.5114/,F(2)/.178847/,F(3)/8.23473/,F(4)/6.67018/,F(5)/
     12.01341/,F(6)/-.29263/,F(7)/1.52080/,F(8)/12.9464/,F(9)/-13.280/,F
     2(10)/10.2971/,F(11)/6.8657/,F(12)/7.3511/,F(13)/.4385/,F(14)/2.070
     33/,F(15)/26.8938/,F(16)/2.0571/,F(17)/102.478/,F(18)/1.2199/,F(19)
     4/10.1060/,F(20)/6.8818/,F(21)/7.3541/,F(22)/.4409/,F(23)/2.2884/,F
     5(24)/20.3004/,F(25)/.0223/,F(26)/115.122/,F(27)/1.2298/,F(28)/9.43
     6141/,F(29)/6.39535/,F(30)/7.74190/,F(31)/.383349/,F(32)/2.15343/,F
     7(33)/15.1908/,F(34)/.016865/,F(35)/63.9690/,F(36)/.656565/,F(37)/1
     85.6887/,F(38)/.679003/,F(39)/8.14208/,F(40)/5.40135/,F(41)/2.03081
     9/,F(42)/9.97278/,F(43)/-9.5760/,F(44)/.940464/,F(45)/1.71430/,F(46
     $)/10.6406/,F(47)/6.1038/,F(48)/7.3537/,F(49)/.3920/,F(50)/3.3240/,
     $F(51)/20.2626/,F(52)/1.4922/,F(53)/98.7399/,F(54)/1.1832/,F(55)/9.
     $54034/,F(56)/5.66078/,F(57)/7.75090/,F(58)/.344261/,F(59)/3.58274/
     $,F(60)/13.3075/,F(61)/.509107/,F(62)/32.4224/,F(63)/.616898/,F(64)
     $/9.68090/,F(65)/5.59463/,F(66)/7.81136/,F(67)/.334393/,F(68)/2.876
     $03/,F(69)/12.8288/,F(70)/.113575/,F(71)/32.8761/,F(72)/.518275/
      DATA G(1)/11.2819/,G(2)/5.3409/,G(3)/7.3573/,G(4)/.3432/,G(5)/3.01
     193/,G(6)/17.8674/,G(7)/2.2441/,G(8)/83.7543/,G(9)/1.0896/,G(10)/10
     2.8061/,G(11)/5.2796/,G(12)/7.3620/,G(13)/.3435/,G(14)/3.5268/,G(15
     3)/14.3430/,G(16)/.2184/,G(17)/41.3235/,G(18)/1.0874/,G(19)/9.84521
     4/,G(20)/4.91797/,G(21)/7.87194/,G(22)/.294393/,G(23)/3.56531/,G(24
     5)/10.8171/,G(25)/.323613/,G(26)/24.1281/,G(27)/.393974/,G(28)/9.96
     6253/,G(29)/4.84850/,G(30)/7.97057/,G(31)/.283303/,G(32)/2.76067/,G
     7(33)/10.4852/,G(34)/.054447/,G(35)/27.5730/,G(36)/.251877/,G(37)/1
     81.7695/,G(38)/4.7611/,G(39)/7.3573/,G(40)/.3072/,G(41)/3.5222/,G(4
     92)/15.3535/,G(43)/2.3045/,G(44)/76.8805/,G(45)/1.0369/,G(46)/11.04
     $24/,G(47)/4.6538/,G(48)/7.3740/,G(49)/.3053/,G(50)/4.1346/,G(51)/1
     $2.0546/,G(52)/.4399/,G(53)/31.2809/,G(54)/1.0097/,G(55)/11.1764/,G
     $(56)/4.6147/,G(57)/7.3863/,G(58)/.3005/,G(59)/3.3948/,G(60)/11.672
     $9/,G(61)/.0724/,G(62)/38.5566/,G(63)/.9707/,G(64)/12.2841/,G(65)/4
     $.2791/,G(66)/7.3409/,G(67)/.2784/,G(68)/4.0034/,G(69)/13.5359/,G(7
     $0)/2.3488/,G(71)/71.1692/,G(72)/1.0118/
      DATA H(1)/11.2296/,H(2)/4.1231/,H(3)/7.3883/,H(4)/.2726/,H(5)/4.73
     193/,H(6)/10.2443/,H(7)/.7108/,H(8)/25.6466/,H(9)/.9324/,H(10)/10.3
     2380/,H(11)/3.90969/,H(12)/7.88173/,H(13)/.238668/,H(14)/4.76795/,H
     3(15)/8.35583/,H(16)/.725591/,H(17)/18.3491/,H(18)/.286667/,H(19)/1
     42.8376/,H(20)/3.8785/,H(21)/7.2920/,H(22)/.2565/,H(23)/4.4438/,H(2
     54)/12.1763/,H(25)/2.3800/,H(26)/66.3421/,H(27)/1.0341/,H(28)/11.41
     666/,H(29)/3.6766/,H(30)/7.4005/,H(31)/.2449/,H(32)/5.3442/,H(33)/8
     7.8730/,H(34)/.9773/,H(35)/22.1626/,H(36)/.8614/,H(37)/10.7806/,H(3
     88)/3.54770/,H(39)/7.75868/,H(40)/.223140/,H(41)/5.22746/,H(42)/7.6
     94468/,H(43)/.847114/,H(44)/16.9673/,H(45)/.386044/,H(46)/13.3380/,
     $H(47)/3.5828/,H(48)/7.1676/,H(49)/.2470/,H(50)/5.6158/,H(51)/11.39
     $66/,H(52)/1.6735/,H(53)/64.8126/,H(54)/1.1910/,H(55)/11.9475/,H(56
     $)/3.3669/,H(57)/7.3573/,H(58)/.2274/,H(59)/6.2455/,H(60)/8.6625/,H
     $(61)/1.5578/,H(62)/25.8487/,H(63)/.8900/,H(64)/11.8168/,H(65)/3.37
     $484/,H(66)/7.11181/,H(67)/.244078/,H(68)/5.78135/,H(69)/7.98760/,H
     $(70)/1.14523/,H(71)/19.8970/,H(72)/1.14431/
      DATA I(1)/14.0743/,I(2)/3.2655/,I(3)/7.0318/,I(4)/.2333/,I(5)/5.16
     152/,I(6)/10.3163/,I(7)/2.4100/,I(8)/58.7097/,I(9)/1.3041/,I(10)/11
     2.9719/,I(11)/2.9946/,I(12)/7.3862/,I(13)/.2031/,I(14)/6.4668/,I(15
     3)/7.0826/,I(16)/1.3940/,I(17)/18.0995/,I(18)/.7807/,I(19)/15.2354/
     4,I(20)/3.0669/,I(21)/6.7006/,I(22)/.2412/,I(23)/4.3591/,I(24)/10.7
     5805/,I(25)/2.9623/,I(26)/61.4135/,I(27)/1.7189/,I(28)/12.6920/,I(2
     69)/2.81262/,I(30)/6.69883/,I(31)/.227890/,I(32)/6.06692/,I(33)/6.3
     76441/,I(34)/1.00660/,I(35)/14.4122/,I(36)/1.53545/,I(37)/16.0816/,
     8I(38)/2.8509/,I(39)/6.3747/,I(40)/.2516/,I(41)/3.7068/,I(42)/11.44
     968/,I(43)/3.6830/,I(44)/54.7625/,I(45)/2.1313/,I(46)/12.9172/,I(47
     $)/2.53718/,I(48)/6.70003/,I(49)/.205855/,I(50)/6.06791/,I(51)/5.47
     $913/,I(52)/.859041/,I(53)/11.6030/,I(54)/1.45572/,I(55)/16.6723/,I
     $(56)/2.6345/,I(57)/6.0701/,I(58)/.2647/,I(59)/3.4313/,I(60)/12.947
     $9/,I(61)/4.2779/,I(62)/47.7972/,I(63)/2.5310/,I(64)/17.0006/,I(65)
     $/2.4098/,I(66)/5.8196/,I(67)/.2726/,I(68)/3.9731/,I(69)/15.2372/,I
     $(70)/4.3543/,I(71)/43.8163/,I(72)/2.8409/
      DATA J(1)/17.1789/,J(2)/2.1723/,J(3)/5.2358/,J(4)/16.5796/,J(5)/5.
     16377/,J(6)/.2609/,J(7)/3.9851/,J(8)/41.4328/,J(9)/2.9557/,J(10)/17
     2.1718/,J(11)/2.2059/,J(12)/6.3338/,J(13)/19.3345/,J(14)/5.5754/,J(
     315)/.2871/,J(16)/3.7272/,J(17)/58.1535/,J(18)/3.1776/,J(19)/17.355
     45/,J(20)/1.9384/,J(21)/6.7286/,J(22)/16.5623/,J(23)/5.5493/,J(24)/
     5.2261/,J(25)/3.5375/,J(26)/39.3972/,J(27)/2.8250/,J(28)/17.1784/,J
     6(29)/1.7888/,J(30)/9.6435/,J(31)/17.3151/,J(32)/5.1399/,J(33)/.274
     78/,J(34)/1.5292/,J(35)/164.934/,J(36)/3.4873/,J(37)/17.5816/,J(38)
     8/1.7139/,J(39)/7.6598/,J(40)/14.7957/,J(41)/5.8981/,J(42)/.1603/,J
     9(43)/2.7817/,J(44)/31.2087/,J(45)/2.0782/,J(46)/17.5663/,J(47)/1.5
     $564/,J(48)/9.8184/,J(49)/14.0988/,J(50)/5.4220/,J(51)/.1664/,J(52)
     $/2.6694/,J(53)/132.376/,J(54)/2.5064/,J(55)/18.0874/,J(56)/1.4907/
     $,J(57)/8.1373/,J(58)/12.6963/,J(59)/2.5654/,J(60)/24.5651/,J(61)/-
     $34.193/,J(62)/-.0138/,J(63)/41.4025/,J(64)/17.7760/,J(65)/1.40290/
     $,J(66)/10.2946/,J(67)/12.8006/,J(68)/5.72629/,J(69)/.125599/,J(70)
     $/3.26588/,J(71)/104.354/,J(72)/1.91213/
C-----CONTAINS THIRD  PART OF SCATTERING FACTOR CONSTANTS BY
C-----CROMER AND MANN  TAKEN FROM INTERNAT TABLES VOL 4
      DATA K(1)/17.9268/,K(2)/1.35417/,K(3)/9.15310/,K(4)/11.2145/,K(5)/
     11.76795/,K(6)/22.6599/,K(7)/-33.108/,K(8)/-.01319/,K(9)/40.2602/,K
     2(10)/17.8765/,K(11)/1.27618/,K(12)/10.9480/,K(13)/11.9160/,K(14)/5
     3.41732/,K(15)/.117622/,K(16)/3.65721/,K(17)/87.6627/,K(18)/2.06929
     4/,K(19)/18.1668/,K(20)/1.21480/,K(21)/10.0562/,K(22)/10.1483/,K(23
     5)/1.01118/,K(24)/21.6054/,K(25)/-2.6479/,K(26)/-.10276/,K(27)/9.41
     6454/,K(28)/17.6142/,K(29)/1.18865/,K(30)/12.0144/,K(31)/11.7660/,K
     7(32)/4.04183/,K(33)/.204785/,K(34)/3.53346/,K(35)/69.7957/,K(36)/3
     8.75591/,K(37)/19.8812/,K(38)/.019175/,K(39)/18.0653/,K(40)/1.13305
     9/,K(41)/11.0177/,K(42)/10.1621/,K(43)/1.94715/,K(44)/28.3389/,K(45
     $)/-12.912/,K(46)/17.9163/,K(47)/1.12446/,K(48)/13.3417/,K(49)/.028
     $781/,K(50)/10.7990/,K(51)/9.28206/,K(52)/.337905/,K(53)/25.7228/,K
     $(54)/-6.3934/,K(55)/3.7025/,K(56)/.2772/,K(57)/17.2356/,K(58)/1.09
     $58/,K(59)/12.8876/,K(60)/11.0040/,K(61)/3.7429/,K(62)/61.6584/,K(6
     $3)/4.3875/,K(64)/21.1664/,K(65)/.014734/,K(66)/18.2017/,K(67)/1.03
     $031/,K(68)/11.7423/,K(69)/9.53659/,K(70)/2.30951/,K(71)/26.6307/,K
     $(72)/-14.421/
      DATA L(1)/21.0149/,L(2)/.014345/,L(3)/18.0992/,L(4)/1.02238/,L(5)/
     111.4632/,L(6)/8.78809/,L(7)/.740625/,L(8)/23.3452/,L(9)/-14.316/,L
     2(10)/17.8871/,L(11)/1.03649/,L(12)/11.1750/,L(13)/8.48061/,L(14)/6
     3.57891/,L(15)/.058881/,L(16)/0.0/,L(17)/0.0/,L(18)/.344941/,L(19)/
     419.1301/,L(20)/.864132/,L(21)/11.0948/,L(22)/8.14487/,L(23)/4.6490
     51/,L(24)/21.5707/,L(25)/2.71263/,L(26)/86.8472/,L(27)/5.40428/,L(2
     68)/19.2674/,L(29)/.808520/,L(30)/12.9182/,L(31)/8.43467/,L(32)/4.8
     76337/,L(33)/24.7997/,L(34)/1.56756/,L(35)/94.2928/,L(36)/5.37874/,
     8L(37)/18.5638/,L(38)/.847329/,L(39)/13.2885/,L(40)/8.37164/,L(41)/
     99.32602/,L(42)/.017662/,L(43)/3.00964/,L(44)/22.8870/,L(45)/-3.189
     $2/,L(46)/18.5003/,L(47)/.844582/,L(48)/13.1787/,L(49)/8.12534/,L(5
     $0)/4.71304/,L(51)/.036495/,L(52)/2.18535/,L(53)/20.8504/,L(54)/1.4
     $2357/,L(55)/19.2957/,L(56)/.751536/,L(57)/14.3501/,L(58)/8.21758/,
     $L(59)/4.73425/,L(60)/25.8749/,L(61)/1.28918/,L(62)/98.6062/,L(63)/
     $5.32800/,L(64)/18.8785/,L(65)/.764252/,L(66)/14.1259/,L(67)/7.8443
     $8/,L(68)/3.32515/,L(69)/21.2487/,L(70)/-6.1989/,L(71)/-.01036/,L(7
     $2)/11.8678/
      DATA M(1)/18.8545/,M(2)/.760825/,M(3)/13.9806/,M(4)/7.62436/,M(5)/
     12.53464/,M(6)/19.3317/,M(7)/-5.6526/,M(8)/-.01020/,M(9)/11.2835/,M
     2(10)/19.3319/,M(11)/.698655/,M(12)/15.5017/,M(13)/7.98929/,M(14)/5
     3.29537/,M(15)/25.2052/,M(16)/.605844/,M(17)/76.8986/,M(18)/5.26593
     4/,M(19)/19.1701/,M(20)/.696219/,M(21)/15.2096/,M(22)/7.55573/,M(23
     5)/4.32234/,M(24)/22.5057/,M(25)/0.0/,M(26)/0.0/,M(27)/5.29160/,M(2
     68)/19.2493/,M(29)/.683839/,M(30)/14.7900/,M(31)/7.14833/,M(32)/2.8
     79289/,M(33)/17.9144/,M(34)/-7.9492/,M(35)/.005127/,M(36)/13.0174/,
     8M(37)/19.2808/,M(38)/.6446/,M(39)/16.6885/,M(40)/7.4726/,M(41)/4.8
     9045/,M(42)/24.6605/,M(43)/1.0463/,M(44)/99.8156/,M(45)/5.1790/,M(4
     $6)/19.1812/,M(47)/.646179/,M(48)/15.9719/,M(49)/7.19123/,M(50)/5.2
     $7475/,M(51)/21.7326/,M(52)/.357534/,M(53)/66.1147/,M(54)/5.21572/,
     $M(55)/19.1643/,M(56)/.645643/,M(57)/16.2456/,M(58)/7.18544/,M(59)/
     $4.37090/,M(60)/21.4072/,M(61)/0.0/,M(62)/0.0/,M(63)/5.21404/,M(64)
     $/19.2214/,M(65)/.5946/,M(66)/17.6444/,M(67)/6.9089/,M(68)/4.4610/,
     $M(69)/24.7008/,M(70)/1.6029/,M(71)/87.4825/,M(72)/5.0694/
      DATA N(1)/19.1514/,N(2)/.597922/,N(3)/17.2535/,N(4)/6.80639/,N(5)/
     14.47128/,N(6)/20.2521/,N(7)/0.0/,N(8)/0.0/,N(9)/5.11937/,N(10)/19.
     21624/,N(11)/.5476/,N(12)/18.5596/,N(13)/6.3776/,N(14)/4.2948/,N(15
     3)/25.8499/,N(16)/2.0396/,N(17)/92.8029/,N(18)/4.9391/,N(19)/19.104
     45/,N(20)/.551522/,N(21)/18.1108/,N(22)/6.32470/,N(23)/3.78897/,N(2
     54)/17.3595/,N(25)/0.0/,N(26)/0.0/,N(27)/4.99635/,N(28)/19.1889/,N(
     629)/5.8303/,N(30)/19.1005/,N(31)/.5031/,N(32)/4.4585/,N(33)/26.890
     79/,N(34)/2.4663/,N(35)/83.9571/,N(36)/4.7821/,N(37)/19.1094/,N(38)
     8/.5036/,N(39)/19.0548/,N(40)/5.8378/,N(41)/4.5648/,N(42)/23.3752/,
     9N(43)/.4870/,N(44)/62.2061/,N(45)/4.7861/,N(46)/18.9333/,N(47)/5.7
     $640/,N(48)/19.7131/,N(49)/.4655/,N(50)/3.4182/,N(51)/14.0049/,N(52
     $)/.0193/,N(53)/-.7583/,N(54)/3.9182/,N(55)/19.6418/,N(56)/5.3034/,
     $N(57)/19.0455/,N(58)/.4607/,N(59)/5.0371/,N(60)/27.9074/,N(61)/2.6
     $827/,N(62)/75.2825/,N(63)/4.5909/,N(64)/18.9755/,N(65)/.467196/,N(
     $66)/18.9330/,N(67)/5.22126/,N(68)/5.10789/,N(69)/19.5902/,N(70)/.2
     $88753/,N(71)/55.5113/,N(72)/4.69626/
      DATA O(1)/19.8685/,O(2)/5.44853/,O(3)/19.0302/,O(4)/.467973/,O(5)/
     12.41253/,O(6)/14.1259/,O(7)/0.0/,O(8)/0.0/,O(9)/4.69263/,O(10)/19.
     29644/,O(11)/4.81742/,O(12)/19.0138/,O(13)/.420885/,O(14)/6.14487/,
     3O(15)/28.5284/,O(16)/2.52390/,O(17)/70.8403/,O(18)/4.35200/,O(19)/
     420.1472/,O(20)/4.3470/,O(21)/18.9949/,O(22)/.3814/,O(23)/7.5138/,O
     5(24)/27.7660/,O(25)/2.2735/,O(26)/66.8776/,O(27)/4.0712/,O(28)/20.
     62332/,O(29)/4.3579/,O(30)/18.9970/,O(31)/.3815/,O(32)/7.8069/,O(33
     7)/29.5259/,O(34)/2.8868/,O(35)/84.9304/,O(36)/4.0714/,O(37)/20.293
     83/,O(38)/3.9282/,O(39)/19.0298/,O(40)/.3440/,O(41)/8.9767/,O(42)/2
     96.4659/,O(43)/1.9900/,O(44)/64.2658/,O(45)/3.7118/,O(46)/20.3892/,
     $O(47)/3.5690/,O(48)/19.1062/,O(49)/.3107/,O(50)/10.6620/,O(51)/24.
     $3879/,O(52)/1.4953/,O(53)/213.904/,O(54)/3.3352/,O(55)/20.3524/,O(
     $56)/3.5520/,O(57)/19.1278/,O(58)/.3086/,O(59)/10.2821/,O(60)/23.71
     $28/,O(61)/.9615/,O(62)/59.4565/,O(63)/3.2791/,O(64)/20.3361/,O(65)
     $/3.2160/,O(66)/19.2970/,O(67)/.2756/,O(68)/10.8880/,O(69)/20.2073/
     $,O(70)/2.6959/,O(71)/167.202/,O(72)/2.7731/
C-----CONTAINS FORTH  PART OF SCATTERING FACTOR CONSTANTS BY
C-----CROMER AND MANN  TAKEN FROM INTERNAT TABLES VOL 4
      DATA P(1)/20.1807/,P(2)/3.21367/,P(3)/19.1136/,P(4)/.283310/,P(5)/
     110.9054/,P(6)/20.0558/,P(7)/.773634/,P(8)/51.7460/,P(9)/3.02902/,P
     2(10)/20.5780/,P(11)/2.94817/,P(12)/19.5990/,P(13)/.244475/,P(14)/1
     31.3727/,P(15)/18.7726/,P(16)/3.28719/,P(17)/133.124/,P(18)/2.14678
     4/,P(19)/20.2489/,P(20)/2.92070/,P(21)/19.3763/,P(22)/.250698/,P(23
     5)/11.6323/,P(24)/17.8211/,P(25)/.336048/,P(26)/54.9453/,P(27)/2.40
     6860/,P(28)/21.1671/,P(29)/2.81219/,P(30)/19.7695/,P(31)/.226836/,P
     7(32)/11.8513/,P(33)/17.6083/,P(34)/3.33049/,P(35)/127.113/,P(36)/1
     8.86264/,P(37)/20.8036/,P(38)/2.77691/,P(39)/19.5590/,P(40)/.231540
     9/,P(41)/11.9369/,P(42)/16.5408/,P(43)/.612376/,P(44)/43.1692/,P(45
     $)/2.09013/,P(46)/20.3235/,P(47)/2.65941/,P(48)/19.8186/,P(49)/.218
     $850/,P(50)/12.1233/,P(51)/15.7992/,P(52)/.144583/,P(53)/62.2355/,P
     $(54)/1.59180/,P(55)/22.0440/,P(56)/2.77393/,P(57)/19.6697/,P(58)/.
     $222087/,P(59)/12.3856/,P(60)/16.7669/,P(61)/2.82428/,P(62)/143.644
     $/,P(63)/2.05830/,P(64)/21.3727/,P(65)/2.64520/,P(66)/19.7491/,P(67
     $)/.214299/,P(68)/12.1329/,P(69)/15.3230/,P(70)/.975180/,P(71)/36.4
     $065/,P(72)/1.77132/
      DATA Q(1)/20.9413/,Q(2)/2.54467/,Q(3)/20.0539/,Q(4)/.202481/,Q(5)/
     112.4668/,Q(6)/14.8137/,Q(7)/.296689/,Q(8)/45.4643/,Q(9)/1.24285/,Q
     2(10)/22.6845/,Q(11)/2.66248/,Q(12)/19.6847/,Q(13)/.210628/,Q(14)/1
     32.7740/,Q(15)/15.8850/,Q(16)/2.85137/,Q(17)/137.903/,Q(18)/1.98486
     4/,Q(19)/21.9610/,Q(20)/2.52722/,Q(21)/19.9339/,Q(22)/.199237/,Q(23
     5)/12.1200/,Q(24)/14.1783/,Q(25)/1.51031/,Q(26)/30.8717/,Q(27)/1.47
     6588/,Q(28)/23.3405/,Q(29)/2.56270/,Q(30)/19.6095/,Q(31)/.202088/,Q
     7(32)/13.1235/,Q(33)/15.1009/,Q(34)/2.87516/,Q(35)/132.721/,Q(36)/2
     8.02876/,Q(37)/22.5527/,Q(38)/2.41740/,Q(39)/20.1108/,Q(40)/.185769
     9/,Q(41)/12.0671/,Q(42)/13.1275/,Q(43)/2.07492/,Q(44)/27.4491/,Q(45
     $)/1.19499/,Q(46)/24.0042/,Q(47)/2.47274/,Q(48)/19.4258/,Q(49)/.196
     $451/,Q(50)/13.4396/,Q(51)/14.3996/,Q(52)/2.89604/,Q(53)/128.007/,Q
     $(54)/2.20963/,Q(55)/23.1504/,Q(56)/2.31641/,Q(57)/20.2599/,Q(58)/.
     $174081/,Q(59)/11.9202/,Q(60)/12.1571/,Q(61)/2.71488/,Q(62)/24.8242
     $/,Q(63)/.954586/,Q(64)/24.6274/,Q(65)/2.3879/,Q(66)/19.0886/,Q(67)
     $/.1942/,Q(68)/13.7603/,Q(69)/13.7546/,Q(70)/2.9227/,Q(71)/123.174/
     $,Q(72)/2.5745/
      DATA R(1)/24.0063/,R(2)/2.27783/,R(3)/19.9504/,R(4)/.173530/,R(5)/
     111.8034/,R(6)/11.6096/,R(7)/3.87243/,R(8)/26.5156/,R(9)/1.36389/,R
     2(10)/23.7497/,R(11)/2.22258/,R(12)/20.3745/,R(13)/.163940/,R(14)/1
     31.8509/,R(15)/11.3110/,R(16)/3.26503/,R(17)/22.9966/,R(18)/.759344
     4/,R(19)/25.0709/,R(20)/2.25341/,R(21)/19.0798/,R(22)/.181951/,R(23
     5)/13.8518/,R(24)/12.9331/,R(25)/3.54545/,R(26)/101.398/,R(27)/2.41
     6960/,R(28)/24.3466/,R(29)/2.13553/,R(30)/20.4208/,R(31)/.155525/,R
     7(32)/11.8708/,R(33)/10.5782/,R(34)/3.71490/,R(35)/21.7029/,R(36)/.
     8645089/,R(37)/25.8976/,R(38)/2.24256/,R(39)/18.2185/,R(40)/.196143
     9/,R(41)/14.3167/,R(42)/12.6648/,R(43)/2.95354/,R(44)/115.362/,R(45
     $)/3.58324/,R(46)/24.9559/,R(47)/2.05601/,R(48)/20.3271/,R(49)/.149
     $525/,R(50)/12.2471/,R(51)/10.0499/,R(52)/3.77300/,R(53)/21.2773/,R
     $(54)/.691967/,R(55)/26.5070/,R(56)/2.18020/,R(57)/17.6383/,R(58)/.
     $202172/,R(59)/14.5596/,R(60)/12.1899/,R(61)/2.96577/,R(62)/111.874
     $/,R(63)/4.29728/,R(64)/25.5395/,R(65)/1.98040/,R(66)/20.2861/,R(67
     $)/.143384/,R(68)/11.9812/,R(69)/9.34972/,R(70)/4.50073/,R(71)/19.5
     $810/,R(72)/.689690/
      DATA S(1)/26.9049/,S(2)/2.07051/,S(3)/17.2940/,S(4)/.197940/,S(5)/
     114.5583/,S(6)/11.4407/,S(7)/3.63837/,S(8)/92.6566/,S(9)/4.56796/,S
     2(10)/26.1296/,S(11)/1.91072/,S(12)/20.0994/,S(13)/.139358/,S(14)/1
     31.9788/,S(15)/8.80018/,S(16)/4.93676/,S(17)/18.5908/,S(18)/.852795
     4/,S(19)/27.6563/,S(20)/2.07356/,S(21)/16.4285/,S(22)/.223545/,S(23
     5)/14.9779/,S(24)/11.3604/,S(25)/2.98233/,S(26)/105.703/,S(27)/5.92
     6046/,S(28)/26.7220/,S(29)/1.84659/,S(30)/19.7748/,S(31)/.137290/,S
     7(32)/12.1506/,S(33)/8.36225/,S(34)/5.17379/,S(35)/17.8974/,S(36)/1
     8.17613/,S(37)/28.1819/,S(38)/2.02859/,S(39)/15.8851/,S(40)/.238849
     9/,S(41)/15.1542/,S(42)/10.9975/,S(43)/2.98706/,S(44)/102.961/,S(45
     $)/6.75621/,S(46)/27.3083/,S(47)/1.78711/,S(48)/19.3320/,S(49)/.136
     $974/,S(50)/12.3339/,S(51)/7.96778/,S(52)/5.38348/,S(53)/17.2922/,S
     $(54)/1.63929/,S(55)/28.6641/,S(56)/1.98890/,S(57)/15.4345/,S(58)/.
     $257119/,S(59)/15.3087/,S(60)/10.6647/,S(61)/2.98963/,S(62)/100.417
     $/,S(63)/7.56672/,S(64)/28.1209/,S(65)/1.78503/,S(66)/17.6817/,S(67
     $)/.159970/,S(68)/13.3335/,S(69)/8.18304/,S(70)/5.14657/,S(71)/20.3
     $900/,S(72)/3.70983/
      DATA T(1)/27.8917/,T(2)/1.73272/,T(3)/18.7614/,T(4)/.138790/,T(5)/
     112.6072/,T(6)/7.64412/,T(7)/5.47647/,T(8)/16.8153/,T(9)/2.26001/,T
     2(10)/28.9476/,T(11)/1.90182/,T(12)/15.2208/,T(13)/9.98519/,T(14)/1
     35.1000/,T(15)/.261033/,T(16)/3.71601/,T(17)/84.3298/,T(18)/7.97628
     4/,T(19)/28.4628/,T(20)/1.68216/,T(21)/18.1210/,T(22)/.142292/,T(23
     5)/12.8429/,T(24)/7.33727/,T(25)/5.59415/,T(26)/16.3535/,T(27)/2.97
     6573/,T(28)/29.1440/,T(29)/1.83262/,T(30)/15.1726/,T(31)/9.59990/,T
     7(32)/14.7586/,T(33)/.275116/,T(34)/4.30013/,T(35)/72.0290/,T(36)/8
     8.58154/,T(37)/28.8131/,T(38)/1.59136/,T(39)/18.4601/,T(40)/.128903
     9/,T(41)/12.7285/,T(42)/6.76232/,T(43)/5.59927/,T(44)/14.0366/,T(45
     $)/2.39699/,T(46)/29.2024/,T(47)/1.77333/,T(48)/15.2293/,T(49)/9.37
     $046/,T(50)/14.5135/,T(51)/.295977/,T(52)/4.76492/,T(53)/63.3644/,T
     $(54)/9.24354/,T(55)/29.1587/,T(56)/1.50711/,T(57)/18.8407/,T(58)/.
     $116741/,T(59)/12.8268/,T(60)/6.31524/,T(61)/5.38695/,T(62)/12.4244
     $/,T(63)/1.78555/,T(64)/29.0818/,T(65)/1.72029/,T(66)/15.4300/,T(67
     $)/9.22590/,T(68)/14.4327/,T(69)/.321703/,T(70)/5.11982/,T(71)/57.0
     $560/,T(72)/9.88750/
C-----CONTAINS FIFTH  PART OF SCATTERING FACTOR CONSTANTS BY
C-----CROMER AND MANN  TAKEN FROM INTERNAT TABLES VOL 4
      DATA U(1)/29.4936/,U(2)/1.42755/,U(3)/19.3763/,U(4)/.104621/,U(5)/
     113.0544/,U(6)/5.93667/,U(7)/5.06412/,U(8)/11.1972/,U(9)/1.01074/,U
     2(10)/28.7621/,U(11)/1.67191/,U(12)/15.7189/,U(13)/9.09227/,U(14)/1
     34.5564/,U(15)/.350500/,U(16)/5.44174/,U(17)/52.0861/,U(18)/10.4720
     4/,U(19)/28.1894/,U(20)/1.62903/,U(21)/16.1550/,U(22)/8.97948/,U(23
     5)/14.9305/,U(24)/.382661/,U(25)/5.67589/,U(26)/48.1647/,U(27)/11.0
     6005/,U(28)/30.4190/,U(29)/1.37113/,U(30)/15.2637/,U(31)/6.84706/,U
     7(32)/14.7458/,U(33)/.165191/,U(34)/5.06795/,U(35)/18.0030/,U(36)/6
     8.49804/,U(37)/27.3049/,U(38)/1.59279/,U(39)/16.7296/,U(40)/8.86553
     9/,U(41)/15.6115/,U(42)/.417916/,U(43)/5.83377/,U(44)/45.0011/,U(45
     $)/11.4722/,U(46)/30.4156/,U(47)/1.34323/,U(48)/15.8620/,U(49)/7.10
     $909/,U(50)/13.6145/,U(51)/.204633/,U(52)/5.82008/,U(53)/20.3254/,U
     $(54)/8.27903/,U(55)/30.7058/,U(56)/1.30923/,U(57)/15.5512/,U(58)/6
     $.71983/,U(59)/14.2326/,U(60)/.167252/,U(61)/5.53672/,U(62)/17.4911
     $/,U(63)/6.96824/,U(64)/27.0059/,U(65)/1.51293/,U(66)/17.7639/,U(67
     $)/8.81174/,U(68)/15.7131/,U(69)/.424593/,U(70)/5.78370/,U(71)/38.6
     $103/,U(72)/11.6883/
      DATA V(1)/29.8429/,V(2)/1.32927/,V(3)/16.7224/,V(4)/7.38979/,V(5)/
     113.2153/,V(6)/.263297/,V(7)/6.35234/,V(8)/22.9426/,V(9)/9.85329/,V
     2(10)/30.9612/,V(11)/1.24813/,V(12)/15.9829/,V(13)/6.60834/,V(14)/1
     33.7348/,V(15)/.168640/,V(16)/5.92034/,V(17)/16.9392/,V(18)/7.39534
     4/,V(19)/16.8819/,V(20)/.4611/,V(21)/18.5913/,V(22)/8.6216/,V(23)/2
     55.5582/,V(24)/1.4826/,V(25)/5.8600/,V(26)/36.3956/,V(27)/12.0658/,
     6V(28)/28.0109/,V(29)/1.35321/,V(30)/17.8204/,V(31)/7.73950/,V(32)/
     714.3359/,V(33)/.356752/,V(34)/6.58077/,V(35)/26.4043/,V(36)/11.229
     89/,V(37)/30.6886/,V(38)/1.21990/,V(39)/16.9029/,V(40)/6.82872/,V(4
     91)/12.7801/,V(42)/.212867/,V(43)/6.52354/,V(44)/18.6590/,V(45)/9.0
     $9680/,V(46)/20.6809/,V(47)/.5450/,V(48)/19.0417/,V(49)/8.4484/,V(5
     $0)/21.6575/,V(51)/1.5729/,V(52)/5.9676/,V(53)/38.3246/,V(54)/12.60
     $89/,V(55)/25.0853/,V(56)/1.39507/,V(57)/18.4973/,V(58)/7.65105/,V(
     $59)/16.8883/,V(60)/.443378/,V(61)/6.48216/,V(62)/28.2262/,V(63)/12
     $.0205/,V(64)/29.5641/,V(65)/1.21152/,V(66)/18.0600/,V(67)/7.05639/
     $,V(68)/12.8374/,V(69)/.284738/,V(70)/6.89912/,V(71)/20.7482/,V(72)
     $/10.6268/
      DATA W(1)/27.5446/,W(2)/.655150/,W(3)/19.1584/,W(4)/8.70751/,W(5)/
     115.5380/,W(6)/1.96347/,W(7)/5.52593/,W(8)/45.8149/,W(9)/13.1746/,W
     2(10)/21.3985/,W(11)/1.47110/,W(12)/20.4723/,W(13)/.517394/,W(14)/1
     38.7478/,W(15)/7.43463/,W(16)/6.82847/,W(17)/28.8482/,W(18)/12.5258
     4/,W(19)/30.8695/,W(20)/1.10080/,W(21)/18.3841/,W(22)/6.53852/,W(23
     5)/11.9328/,W(24)/.219074/,W(25)/7.00574/,W(26)/17.2114/,W(27)/9.80
     6270/,W(28)/31.0617/,W(29)/.6902/,W(30)/13.0637/,W(31)/2.3576/,W(32
     7)/18.4420/,W(33)/8.6180/,W(34)/5.9696/,W(35)/47.2579/,W(36)/13.411
     88/,W(37)/21.7886/,W(38)/1.33660/,W(39)/19.5682/,W(40)/.488383/,W(4
     91)/19.1406/,W(42)/6.77270/,W(43)/7.01107/,W(44)/23.8132/,W(45)/12.
     $4734/,W(46)/32.1244/,W(47)/1.00566/,W(48)/18.8003/,W(49)/6.10926/,
     $W(50)/12.0175/,W(51)/.147041/,W(52)/6.96886/,W(53)/14.7140/,W(54)/
     $8.08428/,W(55)/33.3689/,W(56)/.7040/,W(57)/12.9510/,W(58)/2.9238/,
     $W(59)/16.5877/,W(60)/8.7937/,W(61)/6.4692/,W(62)/48.0093/,W(63)/13
     $.5782/,W(64)/21.8053/,W(65)/1.23560/,W(66)/19.5026/,W(67)/6.24149/
     $,W(68)/19.1053/,W(69)/.469999/,W(70)/7.10295/,W(71)/20.3185/,W(72)
     $/12.4711/
      DATA X(1)/33.5364/,X(2)/.916540/,X(3)/25.0946/,X(4)/.039042/,X(5)/
     119.2497/,X(6)/5.71414/,X(7)/6.91555/,X(8)/12.8285/,X(9)/-6.7994/,X
     2(10)/34.6726/,X(11)/.700999/,X(12)/15.4733/,X(13)/3.55078/,X(14)/1
     33.1138/,X(15)/9.55642/,X(16)/7.02588/,X(17)/47.0045/,X(18)/13.6770
     4/,X(19)/35.3163/,X(20)/.685870/,X(21)/19.0211/,X(22)/3.97458/,X(23
     5)/9.49887/,X(24)/11.3824/,X(25)/7.42518/,X(26)/45.4715/,X(27)/13.7
     6108/,X(28)/35.5631/,X(29)/.6631/,X(30)/21.2816/,X(31)/4.0691/,X(32
     7)/8.0037/,X(33)/14.0422/,X(34)/7.4433/,X(35)/44.2473/,X(36)/13.690
     85/,X(37)/35.9299/,X(38)/.646453/,X(39)/23.0547/,X(40)/4.17619/,X(4
     91)/12.1439/,X(42)/23.1052/,X(43)/2.11253/,X(44)/150.645/,X(45)/13.
     $7247/,X(46)/35.7630/,X(47)/.616341/,X(48)/22.9064/,X(49)/3.87135/,
     $X(50)/12.4739/,X(51)/19.9887/,X(52)/3.21097/,X(53)/142.325/,X(54)/
     $13.6211/,X(55)/35.2150/,X(56)/.604909/,X(57)/21.6700/,X(58)/3.5767
     $0/,X(59)/7.91342/,X(60)/12.6010/,X(61)/7.65078/,X(62)/29.8436/,X(6
     $3)/13.5431/,X(64)/35.6597/,X(65)/.589092/,X(66)/23.1032/,X(67)/3.6
     $5155/,X(68)/12.5977/,X(69)/18.5990/,X(70)/4.08655/,X(71)/117.020/,
     $X(72)/13.5266/
      DATA Y(1)/35.1736/,Y(2)/.579689/,Y(3)/22.1112/,Y(4)/3.41437/,Y(5)/
     18.19216/,Y(6)/12.9187/,Y(7)/7.05545/,Y(8)/25.9443/,Y(9)/13.4637/,Y
     2(10)/35.5645/,Y(11)/.563359/,Y(12)/23.4219/,Y(13)/3.46204/,Y(14)/1
     32.7473/,Y(15)/17.8309/,Y(16)/4.80703/,Y(17)/99.1722/,Y(18)/13.4314
     4/,Y(19)/35.1007/,Y(20)/.555054/,Y(21)/22.4418/,Y(22)/3.24498/,Y(23
     5)/9.78554/,Y(24)/13.4661/,Y(25)/5.29444/,Y(26)/23.9533/,Y(27)/13.3
     6760/,Y(28)/35.8847/,Y(29)/.547751/,Y(30)/23.2948/,Y(31)/3.41519/,Y
     7(32)/14.1891/,Y(33)/16.9235/,Y(34)/4.17287/,Y(35)/105.251/,Y(36)/1
     83.4287/,Y(37)/36.0228/,Y(38)/.5293/,Y(39)/23.4128/,Y(40)/3.3253/,Y
     9(41)/14.9491/,Y(42)/16.0927/,Y(43)/4.1880/,Y(44)/100.613/,Y(45)/13
     $.3966/,Y(46)/35.5747/,Y(47)/.520480/,Y(48)/22.5259/,Y(49)/3.12293/
     $,Y(50)/12.2165/,Y(51)/12.7148/,Y(52)/5.37073/,Y(53)/26.3394/,Y(54)
     $/13.3092/,Y(55)/35.3715/,Y(56)/.516598/,Y(57)/22.5326/,Y(58)/3.050
     $53/,Y(59)/12.0291/,Y(60)/12.5723/,Y(61)/4.79840/,Y(62)/23.4582/,Y(
     $63)/13.2671/,Y(64)/34.8509/,Y(65)/.507079/,Y(66)/22.7584/,Y(67)/2.
     $89030/,Y(68)/14.0099/,Y(69)/13.1767/,Y(70)/1.21457/,Y(71)/25.2017/
     $,Y(72)/13.1665/
C-----CONTAINS SIXTH  PART OF SCATTERING FACTOR CONSTANTS BY
C-----CROMER AND MANN  TAKEN FROM INTERNAT TABLES VOL 4
      DATA Z(1)/36.1874/,Z(2)/.511929/,Z(3)/23.5964/,Z(4)/3.25396/,Z(5)/
     115.6402/,Z(6)/15.3622/,Z(7)/4.18550/,Z(8)/97.4908/,Z(9)/13.3573/,Z
     2(10)/35.0136/,Z(11)/.489810/,Z(12)/22.7286/,Z(13)/2.81099/,Z(14)/1
     34.3884/,Z(15)/12.3300/,Z(16)/1.75669/,Z(17)/22.6581/,Z(18)/13.1130
     4/,Z(19)/36.5254/,Z(20)/.499384/,Z(21)/23.8083/,Z(22)/3.26371/,Z(23
     5)/16.7707/,Z(24)/14.9455/,Z(25)/3.47947/,Z(26)/105.980/,Z(27)/13.3
     6812/,Z(28)/35.7074/,Z(29)/.502322/,Z(30)/22.6130/,Z(31)/3.03807/,Z
     7(32)/12.9898/,Z(33)/12.1449/,Z(34)/5.43227/,Z(35)/25.4928/,Z(36)/1
     83.2544/,Z(37)/35.5103/,Z(38)/.498626/,Z(39)/22.5787/,Z(40)/2.96627
     9/,Z(41)/12.7766/,Z(42)/11.9484/,Z(43)/4.92159/,Z(44)/22.7502/,Z(45
     $)/13.2116/,Z(46)/35.8400/,Z(47)/.484938/,Z(48)/22.7169/,Z(49)/2.96
     $118/,Z(50)/13.5807/,Z(51)/11.5331/,Z(52)/5.66016/,Z(53)/24.3992/,Z
     $(54)/13.1991/,Z(55)/35.6493/,Z(56)/.481422/,Z(57)/22.6460/,Z(58)/2
     $.89020/,Z(59)/13.3595/,Z(60)/11.3160/,Z(61)/5.18831/,Z(62)/21.8301
     $/,Z(63)/13.1555/,Z(64)/35.1736/,Z(65)/.473204/,Z(66)/22.7181/,Z(67
     $)/2.73848/,Z(68)/14.7635/,Z(69)/11.5530/,Z(70)/2.28678/,Z(71)/20.9
     $303/,Z(72)/13.0582/
      DATA Z1(1)/36.6706/,Z1(2)/.483629/,Z1(3)/24.0992/,Z1(4)/3.20647/,Z
     11(5)/17.3415/,Z1(6)/14.3136/,Z1(7)/3.49331/,Z1(8)/102.273/,Z1(9)/1
     23.3592/,Z1(10)/36.6488/,Z1(11)/.465154/,Z1(12)/24.4096/,Z1(13)/3.0
     38997/,Z1(14)/17.3990/,Z1(15)/13.4346/,Z1(16)/4.21665/,Z1(17)/88.48
     434/,Z1(18)/13.2887/,Z1(19)/36.7881/,Z1(20)/.451018/,Z1(21)/24.7736
     5/,Z1(22)/3.04619/,Z1(23)/17.8919/,Z1(24)/12.8946/,Z1(25)/4.23284/,
     6Z1(26)/86.0030/,Z1(27)/13.2754/,Z1(28)/36.9185/,Z1(29)/0.437533/,Z
     71(30)/25.1995/,Z1(31)/3.00775/,Z1(32)/18.3317/,Z1(33)/12.4044/,Z1(
     834)/4.24391/,Z1(35)/83.7881/,Z1(36)/13.2674/,Z1(37)/4.758/,
     9Z1(38)/7.831/,Z1(39)/3.637/,Z1(40)/30.05/,Z1(41)/0./,Z1(42)/0./,
     XZ1(43)/0./,Z1(44)/0./,Z1(45)/1.594/,Z1(46)/0./,Z1(47)/0./,
     XZ1(48)/0./,Z1(49)/0./,Z1(50)/0./,Z1(51)/0./,Z1(52)/0./,Z1(53)/0./,
     XZ1(54)/1./
C-----CONTAINS WAVELENGTH SYMBOLS
      DATA Z2(1)/'CRA1'/,Z2(2)/'CRA2'/,Z2(3)/'CRB '/,Z2(4)/'CR  '/,
     1Z2(5)/'FEA1'/,Z2(6)/'FEA2'/,Z2(7)/'FEB '/,Z2(8)/'FE  '/,
     2Z2(9)/'CUA1'/,Z2(10)/'CUA2'/,Z2(11)/'CUB '/,Z2(12)/'CU  '/,
     3Z2(13)/'MOA1'/,Z2(14)/'MOA2'/,Z2(15)/'MOB '/,Z2(16)/'MO  '/,
     4Z2(17)/'AGA1'/,Z2(18)/'AGA2'/,Z2(19)/'AGB '/,Z2(20)/'AG  '/
      END
C
C-----------------------------------------------------------------------
      SUBROUTINE ANOMA (ANODE,ELEMEN,KODLP)
C-----------------------------------------------------------------------
C
C-----CALCULATE ANOM DISPERSION COEFFICIENTS AND NEUTRON SCATT.LENGTH
      COMMON /ANOMAL/ DELFR,DELFI
      COMMON /UNITS/ ICR,IPR,ILU
      COMMON /WAVEL/ M
      DIMENSION N(98), M(20)
      INTEGER ELEMEN,ANODE
C-----
      DATA N(1)/'LI  '/,N(2)/'BE  '/,N(3)/'B   '/,N(4)/'C   '/,N(5)/'N
     1 '/,N(6)/'O   '/,N(7)/'F   '/,N(8)/'NE  '/,N(9)/'NA  '/,N(10)/'MG
     2 '/,N(11)/'AL  '/,N(12)/'SI  '/,N(13)/'P   '/,N(14)/'S   '/,N(15)/
     3'CL  '/,N(16)/'AR  '/,N(17)/'K   '/,N(18)/'CA  '/,N(19)/'SC  '/,N(
     420)/'TI  '/,N(21)/'V   '/,N(22)/'CR  '/,N(23)/'MN  '/,N(24)/'FE  '
     5/,N(25)/'CO  '/,N(26)/'NI  '/,N(27)/'CU  '/,N(28)/'ZN  '/,N(29)/'G
     6A  '/,N(30)/'GE  '/,N(31)/'AS  '/,N(32)/'SE  '/,N(33)/'BR  '/,N(34
     7)/'KR  '/,N(35)/'RB  '/,N(36)/'SR  '/,N(37)/'Y   '/,N(38)/'ZR  '/,
     8N(39)/'NB  '/,N(40)/'MO  '/
      DATA N(41)/'TC  '/,N(42)/'RU  '/,N(43)/'RH  '/,N(44)/'PD  '/,N(45)
     1/'AG  '/,N(46)/'CD  '/,N(47)/'IN  '/,N(48)/'SN  '/,N(49)/'SB  '/,N
     2(50)/'TE  '/,N(51)/'I   '/,N(52)/'XE  '/,N(53)/'CS  '/,N(54)/'BA
     3'/,N(55)/'LA  '/,N(56)/'CE  '/,N(57)/'PR  '/,N(58)/'ND  '/,N(59)/'
     4PM  '/,N(60)/'SM  '/,N(61)/'EU  '/,N(62)/'GD  '/,N(63)/'TB  '/,N(6
     54)/'DY  '/,N(65)/'HO  '/,N(66)/'ER  '/,N(67)/'TM  '/,N(68)/'YB  '/
     6,N(69)/'LU  '/,N(70)/'HF  '/,N(71)/'TA  '/,N(72)/'W   '/,N(73)/'RE
     7  '/,N(74)/'OS  '/,N(75)/'IR  '/,N(76)/'PT  '/,N(77)/'AU  '/,N(78)
     8/'HG  '/,N(79)/'TL  '/,N(80)/'PB  '/
      DATA N(81)/'BI  '/,N(82)/'PO  '/,N(83)/'AT  '/,N(84)/'RN  '/,N(85)
     1/'FR  '/,N(86)/'RA  '/,N(87)/'AC  '/,N(88)/'TH  '/,N(89)/'PA  '/,N
     2(90)/'U   '/,N(91)/'NP  '/,N(92)/'PU  '/,N(93)/'AM  '/,N(94)/'CM
     3'/,N(95)/'BK  '/,N(96)/'CF  '/,N(97)/'H   '/,N(98)/'D.  '/
C-----IDENTIFY ELEMEN  FOR RETRIEVING NEUTRON SCATTERING LENGTH
      IF (KODLP.EQ.2) GO TO 3
C-----IDENTIFY WAVELENGTH
      DO 1 I=1,20
      IF (ANODE.EQ.M(I)) GO TO 2
 1    CONTINUE
      WRITE (IPR,14) ANODE
      GO TO 5
 2    INDICE=(FLOAT(I)-1.)/4.+1.
C-----IDENTIFY ELEMENT SYMBOL
 3    DO 4 I=1,98
      IF (ELEMEN.EQ.N(I)) GO TO 6
 4    CONTINUE
   16 IF (KODLP.NE.2) WRITE (IPR,15) ELEMEN
 5    DELFR=0.
      DELFI=0.
      RETURN
 6    IF (KODLP.NE.2) GO TO 7
      CALL NEUTF (I)
      RETURN
 7    INDE=2*I-1
      IF (INDE .GT. 192) GO TO 16
      GO TO (8,9,10,11,12), INDICE
 8    CALL CHROME (INDE)
      GO TO 13
 9    CALL FER (INDE)
      GO TO 13
 10   CALL CUIVRE (INDE)
      GO TO 13
 11   CALL MOLYBD (INDE)
      GO TO 13
 12   CALL ARGENT (INDE)
 13   RETURN
C
 14   FORMAT (13H THE ANODE **,A4,21H**  IS NOT RECOGNIZED /
     152H NO CORRECTION FOR ANOMALOUS DISPERSION WILL BE MADE)
 15   FORMAT (11H SYMBOL ***,A4,43H*** IS NOT ALLOWED FOR ANOMALOUS DISP
     1ERSION,/44H NO CORRECTION FOR THIS ELEMENT WILL BE MADE )
      END
C
C--------------------------------------------------------------------------
      SUBROUTINE NEUTF (I)
C--------------------------------------------------------------------------
C
      DIMENSION A(98)
      COMMON /NEU/ FNEU
      DATA A(1)/-.194/,A(2)/.774/,A(3)/.54/,A(4)/.663/,A(5)/.94/,A(6)/.5
     175/,A(7)/.57/,A(8)/.46/,A(9)/.351/,A(10)/.52/,A(11)/.345/,A(12)/.4
     215/,A(13)/.51/,A(14)/.285/,A(15)/.958/,A(16)/.20/,A(17)/.37/,A(18)
     3/.49/,A(19)/1.18/,A(20)/-.33/,A(21)/-.05/,A(22)/.352/,A(23)/-.36/,
     4A(24)/.95/,A(25)/.25/,A(26)/1.03/,A(27)/.76/,A(28)/.57/,A(29)/.72/
     5,A(30)/.84/,A(31)/.64/,A(32)/.80/,A(33)/.68/,A(34)/.74/,A(35)/.70/
     6,A(36)/.69/,A(37)/.79/,A(38)/.69/,A(39)/.71/,A(40)/.66/,A(41)/.68/
     7,A(42)/.73/,A(43)/.59/,A(44)/.60/,A(45)/.61/,A(46)/.37/,A(47)/.39/
     8,A(48)/.61/,A(49)/.56/,A(50)/.54/
      DATA A(51)/.52/,A(52)/.47/,A(53)/.55/,A(54)/.52/,A(55)/.83/,A(56)/
     1.46/,A(57)/.44/,A(58)/.72/,A(59)/.0/,A(60)/.0/,A(61)/.55/,A(62)/1.
     25/,A(63)/.76/,A(64)/1.69/,A(65)/.85/,A(66)/.79/,A(67)/.69/,A(68)/1
     3.26/,A(69)/.73/,A(70)/.78/,A(71)/.70/,A(72)/.48/,A(73)/.92/,A(74)/
     41.07/,A(75)/1.06/,A(76)/.95/,A(77)/.76/,A(78)/1.27/,A(79)/.89/,A(8
     50)/.94/,A(81)/.85/,A(82)/.0/,A(83)/.0/,A(84)/.0/,A(85)/.0/,A(86)/.
     60/,A(87)/.0/,A(88)/.99/,A(89)/.0/,A(90)/.84/,A(91)/1.055/,A(92)/.7
     75/,A(93)/.0/,A(94)/.0/,A(95)/.0/,A(96)/.0/,A(97)/-.372/,A(98)/.67/
      FNEU=A(I)
      RETURN
      END
C
C--------------------------------------------------------------------------
      SUBROUTINE CHROME (I)
C--------------------------------------------------------------------------
C
C-----CONTAINS ANOMALOUS DISPERSION CORRECTION TERMS FOR  CRK
C-----TABULATED IN THE INTERNATIONAL TABLES VOLUME 4 PAGE 149
      COMMON /ANOMAL/ DELFR,DELFI
      DIMENSION C(192)
      DATA C(1)/0.002/,C(2)/0.001/,C(3)/0.008/,C(4)/0.003/,C(5)/0.018/,C
     1(6)/0.009/,C(7)/0.035/,C(8)/0.021/,C(9)/0.059/,C(10)/0.042/,C(11)/
     20.090/,C(12)/0.073/,C(13)/0.129/,C(14)/0.119/,C(15)/0.174/,C(16)/0
     3.184/,C(17)/0.223/,C(18)/0.270/,C(19)/0.272/,C(20)/0.381/,C(21)/0.
     4318/,C(22)/0.522/,C(23)/0.355/,C(24)/0.693/,C(25)/0.377/,C(26)/0.9
     500/,C(27)/0.374/,C(28)/1.142/,C(29)/0.335/,C(30)/1.423/,C(31)/0.24
     63/,C(32)/1.747/,C(33)/0.070/,C(34)/2.110/,C(35)/-0.221/,C(36)/2.51
     74/,C(37)/-0.717/,C(38)/2.968/,C(39)/-1.683/,C(40)/3.470/
      DATA C(41)/-3.841/,C(42)/0.459/,C(43)/-2.161/,C(44)/0.548/,C(45)/-
     11.639/,C(46)/0.650/,C(47)/-1.339/,C(48)/0.764/,C(49)/-1.124/,C(50)
     2/0.893/,C(51)/-0.956/,C(52)/1.036/,C(53)/-0.795/,C(54)/1.196/,C(55
     3)/-0.684/,C(56)/1.373/,C(57)/-0.570/,C(58)/1.569/,C(59)/-0.462/,C(
     460)/1.786/,C(61)/-0.365/,C(62)/2.022/,C(63)/-0.273/,C(64)/2.283/,C
     5(65)/-0.198/,C(66)/2.563/,C(67)/-0.130/,C(68)/2.872/,C(69)/-0.082/
     6,C(70)/3.201/,C(71)/-0.012/,C(72)/3.608/,C(73)/0.006/,C(74)/4.002/
     7,C(75)/0.007/,C(76)/4.422/,C(77)/-0.013/,C(78)/4.876/,C(79)/-0.063
     8/,C(80)/5.353/
      DATA C(81)/-0.153/,C(82)/5.862/,C(83)/-0.270/,C(84)/6.406/,C(85)/-
     10.424/,C(86)/6.984/,C(87)/-0.639/,C(88)/7.594/,C(89)/-0.924/,C(90)
     2/8.235/,C(91)/-1.303/,C(92)/8.912/,C(93)/-1.788/,C(94)/9.627/,C(95
     3)/-2.401/,C(96)/10.380/,C(97)/-3.194/,C(98)/11.166/,C(99)/-4.267/,
     4C(100)/11.995/,C(101)/-5.852/,C(102)/12.850/,C(103)/-8.133/,C(104)
     5/11.933/,C(105)/-10.742/,C(106)/12.919/,C(107)/-11.460/,C(108)/9.9
     681/,C(109)/-12.135/,C(110)/3.565/,C(111)/-9.574/,C(112)/3.843/,C(1
     713)/-7.817/,C(114)/4.130/,C(115)/-7.486/,C(116)/4.427/,C(117)/-6.8
     891/,C(118)/4.741/,C(119)/-6.429/,C(120)/5.073/
      DATA C(121)/-6.050/,C(122)/5.416/,C(123)/-5.779/,C(124)/5.773/,C(1
     125)/-5.525/,C(126)/6.153/,C(127)/-5.250/,C(128)/6.549/,C(129)/-5.0
     240/,C(130)/6.958/,C(131)/-4.878/,C(132)/7.387/,C(133)/-4.753/,C(13
     34)/7.833/,C(135)/-4.652/,C(136)/8.291/,C(137)/-4.580/,C(138)/8.759
     4/,C(139)/-4.592/,C(140)/9.277/,C(141)/-4.540/,C(142)/9.811/,C(143)
     5/-4.499/,C(144)/10.364/,C(145)/-4.483/,C(146)/10.929/,C(147)/-4.50
     63/,C(148)/11.520/,C(149)/-4.527/,C(150)/12.140/,C(151)/-4.584/,C(1
     752)/12.787/,C(153)/-4.668/,C(154)/13.451/,C(155)/-4.803/,C(156)/14
     8.143/,C(157)/-4.945/,C(158)/14.860/,C(159)/-5.161/,C(160)/15.595/
      DATA C(161)/-5.420/,C(162)/16.341/,C(163)/-5.742/,C(164)/17.139/,C
     1(165)/-6.132/,C(166)/17.942/,C(167)/-6.545/,C(168)/18.775/,C(169)/
     2-7.052/,C(170)/19.615/,C(171)/-7.614/,C(172)/20.461/,C(173)/-8.318
     3/,C(174)/21.327/,C(175)/-9.150/,C(176)/22.240/,C(177)/-10.382/,C(1
     478)/23.161/,C(179)/-10.930/,C(180)/23.121/,C(181)/-12.152/,C(182)/
     524.097/,C(183)/-12.280/,C(184)/23.658/,C(185)/-12.771/,C(186)/24.6
     607/,C(187)/-13.513/,C(188)/25.540/,C(189)/-14.827/,C(190)/26.801/,
     7C(191)/-16.272/,C(192)/27.898/
      DELFR=C(I)
      I=I+1
      DELFI=C(I)
      RETURN
      END
C
C------------------------------------------------------------------------
      SUBROUTINE FER (I)
C------------------------------------------------------------------------
C
C-----CONTAINS ANOMALOUS DISPERSION CORRECTION TERMS FOR  FEK
C-----TABULATED IN THE INTERNATIONAL TABLES VOLUME 4 PAGE 149
      COMMON /ANOMAL/ DELFR,DELFI
      DIMENSION C(192)
      DATA C(1)/0.002/,C(2)/0.001/,C(3)/0.005/,C(4)/0.002/,C(5)/0.013/,C
     1(6)/0.007/,C(7)/0.026/,C(8)/0.015/,C(9)/0.044/,C(10)/0.029/,C(11)/
     20.069/,C(12)/0.052/,C(13)/0.100/,C(14)/0.085/,C(15)/0.138/,C(16)/0
     3.132/,C(17)/0.180/,C(18)/0.195/,C(19)/0.224/,C(20)/0.277/,C(21)/0.
     4269/,C(22)/0.381/,C(23)/0.311/,C(24)/0.509/,C(25)/0.347/,C(26)/0.6
     564/,C(27)/0.370/,C(28)/0.847/,C(29)/0.375/,C(30)/1.061/,C(31)/0.35
     62/,C(32)/1.309/,C(33)/0.286/,C(34)/1.589/,C(35)/0.163/,C(36)/1.904
     7/,C(37)/-0.038/,C(38)/2.256/,C(39)/-0.357/,C(40)/2.643/
      DATA C(41)/-0.896/,C(42)/3.070/,C(43)/-1.973/,C(44)/3.533/,C(45)/-
     13.367/,C(46)/0.481/,C(47)/-2.095/,C(48)/0.566/,C(49)/-1.623/,C(50)
     2/0.662/,C(51)/-1.343/,C(52)/0.769/,C(53)/-1.129/,C(54)/0.888/,C(55
     3)/-0.978/,C(56)/1.021/,C(57)/-0.841/,C(58)/1.168/,C(59)/-0.717/,C(
     460)/1.331/,C(61)/-0.607/,C(62)/1.508/,C(63)/-0.503/,C(64)/1.704/,C
     5(65)/-0.413/,C(66)/1.916/,C(67)/-0.328/,C(68)/2.149/,C(69)/-0.256/
     6,C(70)/2.398/,C(71)/-0.161/,C(72)/2.709/,C(73)/-0.106/,C(74)/3.009
     7/,C(75)/-0.061/,C(76)/3.329/,C(77)/-0.028/,C(78)/3.676/,C(79)/-0.0
     812/,C(80)/4.043/
      DATA C(81)/-0.017/,C(82)/4.434/,C(83)/-0.039/,C(84)/4.854/,C(85)/-
     10.083/,C(86)/5.300/,C(87)/-0.157/,C(88)/5.773/,C(89)/-0.259/,C(90)
     2/6.271/,C(91)/-0.416/,C(92)/6.800/,C(93)/-0.626/,C(94)/7.356/,C(95
     3)/-0.888/,C(96)/7.943/,C(97)/-1.214/,C(98)/8.557/,C(99)/-1.630/,C(
     4100)/9.203/,C(101)/-2.147/,C(102)/9.885/,C(103)/-2.812/,C(104)/10.
     5608/,C(105)/-3.652/,C(106)/11.382/,C(107)/-4.832/,C(108)/12.164/,C
     6(109)/-6.683/,C(110)/12.937/,C(111)/-8.388/,C(112)/11.953/,C(113)/
     7-12.457/,C(114)/6.285/,C(115)/-11.016/,C(116)/9.874/,C(117)/-12.12
     82/,C(118)/3.627/,C(119)/-9.616/,C(120)/3.883/
      DATA C(121)/-8.352/,C(122)/4.149/,C(123)/-7.565/,C(124)/4.427/,C(1
     125)/-6.980/,C(126)/4.721/,C(127)/-6.492/,C(128)/5.026/,C(129)/-6.1
     212/,C(130)/5.343/,C(131)/-5.810/,C(132)/5.675/,C(133)/-5.565/,C(13
     34)/6.022/,C(135)/-5.361/,C(136)/6.378/,C(137)/-5.190/,C(138)/6.745
     4/,C(139)/-5.088/,C(140)/7.148/,C(141)/-4.948/,C(142)/7.565/,C(143)
     5/-4.823/,C(144)/7.996/,C(145)/-4.719/,C(146)/8.439/,C(147)/-4.647/
     6,C(148)/8.903/,C(149)/-4.578/,C(150)/9.389/,C(151)/-4.535/,C(152)/
     79.895/,C(153)/-4.510/,C(154)/10.418/,C(155)/-4.523/,C(156)/10.963/
     8,C(157)/-4.532/,C(158)/11.528/,C(159)/-4.595/,C(160)/12.108/
      DATA C(161)/-4.688/,C(162)/12.700/,C(163)/-4.817/,C(164)/13.331/,C
     1(165)/-4.991/,C(166)/13.969/,C(167)/-5.173/,C(168)/14.629/,C(169)/
     2-5.402/,C(170)/15.299/,C(171)/-5.659/,C(172)/15.977/,C(173)/-5.976
     3/,C(174)/16.668/,C(175)/-6.313/,C(176)/17.397/,C(177)/-6.695/,C(17
     48)/18.140/,C(179)/-7.126/,C(180)/18.879/,C(181)/-7.624/,C(182)/19.
     5642/,C(183)/-8.187/,C(184)/20.425/,C(185)/-8.872/,C(186)/21.173/,C
     6(187)/-9.743/,C(188)/21.896/,C(189)/-10.539/,C(190)/21.942/,C(191)
     7/-11.641/,C(192)/22.785/
      DELFR=C(I)
      I=I+1
      DELFI=C(I)
      RETURN
      END
C
C---------------------------------------------------------------------------
      SUBROUTINE CUIVRE (I)
C---------------------------------------------------------------------------
C
C-----CONTAINS ANOMALOUS DISPERSION CORRECTION TERMS FOR  CUK
C-----TABULATED IN THE INTERNATIONAL TABLES VOLUME 4 PAGE 149
      COMMON /ANOMAL/ DELFR,DELFI
      DIMENSION C(192)
      DATA C(1)/0.001/,C(2)/0.000/,C(3)/0.003/,C(4)/0.000/,C(5)/0.008/,C
     1(6)/0.004/,C(7)/0.017/,C(8)/0.009/,C(9)/0.029/,C(10)/0.018/,C(11)/
     20.047/,C(12)/0.032/,C(13)/0.069/,C(14)/0.053/,C(15)/0.097/,C(16)/0
     3.083/,C(17)/0.129/,C(18)/0.124/,C(19)/0.165/,C(20)/0.177/,C(21)/0.
     4204/,C(22)/0.246/,C(23)/0.244/,C(24)/0.330/,C(25)/0.283/,C(26)/0.4
     534/,C(27)/0.319/,C(28)/0.557/,C(29)/0.348/,C(30)/0.702/,C(31)/0.36
     66/,C(32)/0.872/,C(33)/0.365/,C(34)/1.066/,C(35)/0.341/,C(36)/1.286
     7/,C(37)/0.285/,C(38)/1.533/,C(39)/0.189/,C(40)/1.807/
      DATA C(41)/0.035/,C(42)/2.110/,C(43)/-0.198/,C(44)/2.443/,C(45)/-0
     1.568/,C(46)/2.808/,C(47)/-1.179/,C(48)/3.204/,C(49)/-2.464/,C(50)/
     23.608/,C(51)/-2.956/,C(52)/0.509/,C(53)/-2.019/,C(54)/0.589/,C(55)
     3/-1.612/,C(56)/0.678/,C(57)/-1.354/,C(58)/0.777/,C(59)/-1.163/,C(6
     40)/0.886/,C(61)/-1.011/,C(62)/1.006/,C(63)/-0.879/,C(64)/1.139/,C(
     565)/-0.767/,C(66)/1.283/,C(67)/-0.665/,C(68)/1.439/,C(69)/-0.574/,
     6C(70)/1.608/,C(71)/-0.465/,C(72)/1.820/,C(73)/-0.386/,C(74)/2.025/
     7,C(75)/-0.314/,C(76)/2.245/,C(77)/-0.248/,C(78)/2.482/,C(79)/-0.19
     81/,C(80)/2.735/
      DATA C(81)/-0.145/,C(82)/3.005/,C(83)/-0.105/,C(84)/3.296/,C(85)/-
     10.077/,C(86)/3.605/,C(87)/-0.059/,C(88)/3.934/,C(89)/-0.060/,C(90)
     2/4.282/,C(91)/-0.079/,C(92)/4.653/,C(93)/-0.126/,C(94)/5.045/,C(95
     3)/-0.194/,C(96)/5.459/,C(97)/-0.287/,C(98)/5.894/,C(99)/-0.418/,C(
     4100)/6.352/,C(101)/-0.579/,C(102)/6.835/,C(103)/-0.783/,C(104)/7.3
     548/,C(105)/-1.022/,C(106)/7.904/,C(107)/-1.334/,C(108)/8.460/,C(10
     69)/-1.716/,C(110)/9.036/,C(111)/-2.170/,C(112)/9.648/,C(113)/-2.93
     79/,C(114)/10.535/,C(115)/-3.431/,C(116)/10.933/,C(117)/-4.357/,C(1
     818)/11.614/,C(119)/-5.696/,C(120)/12.320/
      DATA C(121)/-7.718/,C(122)/11.276/,C(123)/-9.242/,C(124)/11.946/,C
     1(125)/-9.498/,C(126)/9.242/,C(127)/-10.423/,C(128)/9.748/,C(129)/-
     212.255/,C(130)/3.704/,C(131)/-9.733/,C(132)/3.937/,C(133)/-8.488/,
     3C(134)/4.181/,C(135)/-7.701/,C(136)/4.432/,C(137)/-7.133/,C(138)/4
     4.693/,C(139)/-6.715/,C(140)/4.977/,C(141)/-6.351/,C(142)/5.271/,C(
     5143)/-6.048/,C(144)/5.577/,C(145)/-5.790/,C(146)/5.891/,C(147)/-5.
     6581/,C(148)/6.221/,C(149)/-5.391/,C(150)/6.566/,C(151)/-5.233/,C(1
     752)/6.925/,C(153)/-5.096/,C(154)/7.297/,C(155)/-4.990/,C(156)/7.68
     86/,C(157)/-4.883/,C(158)/8.089/,C(159)/-4.818/,C(160)/8.505/
      DATA C(161)/-4.776/,C(162)/8.930/,C(163)/-4.756/,C(164)/9.383/,C(1
     165)/-4.772/,C(166)/9.843/,C(167)/-4.787/,C(168)/10.317/,C(169)/-4.
     2833/,C(170)/10.803/,C(171)/-4.898/,C(172)/11.296/,C(173)/-4.994/,C
     3(174)/11.799/,C(175)/-5.091/,C(176)/12.330/,C(177)/-5.216/,C(178)/
     412.868/,C(179)/-5.359/,C(180)/13.409/,C(181)/-5.529/,C(182)/13.967
     5/,C(183)/-5.712/,C(184)/14.536/,C(185)/-5.930/,C(186)/15.087/,C(18
     67)/-6.176/,C(188)/15.634/,C(189)/-6.498/,C(190)/16.317/,C(191)/-6.
     7798/,C(192)/16.930/
      DELFR=C(I)
      I=I+1
      DELFI=C(I)
      RETURN
      END
C
C--------------------------------------------------------------------------
      SUBROUTINE MOLYBD (I)
C--------------------------------------------------------------------------
C
C-----CONTAINS ANOMALOUS DISPERSION CORRECTION TERMS FOR  MOK
C-----TABULATED IN THE INTERNATIONAL TABLES VOLUME 4 PAGE 149
      COMMON /ANOMAL/ DELFR,DELFI
      DIMENSION C(192)
      DATA C(1)/0.000/,C(2)/0.000/,C(3)/0.000/,C(4)/0.000/,C(5)/0.000/,C
     1(6)/0.001/,C(7)/0.002/,C(8)/0.002/,C(9)/0.004/,C(10)/0.003/,C(11)/
     20.008/,C(12)/0.006/,C(13)/0.014/,C(14)/0.010/,C(15)/0.021/,C(16)/0
     3.016/,C(17)/0.030/,C(18)/0.025/,C(19)/0.042/,C(20)/0.036/,C(21)/0.
     4056/,C(22)/0.052/,C(23)/0.072/,C(24)/0.071/,C(25)/0.090/,C(26)/0.0
     595/,C(27)/0.110/,C(28)/0.124/,C(29)/0.132/,C(30)/0.159/,C(31)/0.15
     65/,C(32)/0.201/,C(33)/0.179/,C(34)/0.250/,C(35)/0.203/,C(36)/0.306
     7/,C(37)/0.226/,C(38)/0.372/,C(39)/0.248/,C(40)/0.446/
      DATA C(41)/0.267/,C(42)/0.530/,C(43)/0.284/,C(44)/0.624/,C(45)/0.2
     195/,C(46)/0.729/,C(47)/0.301/,C(48)/0.845/,C(49)/0.299/,C(50)/0.97
     23/,C(51)/0.285/,C(52)/1.113/,C(53)/0.263/,C(54)/1.266/,C(55)/0.222
     3/,C(56)/1.431/,C(57)/0.163/,C(58)/1.609/,C(59)/0.081/,C(60)/1.801/
     4,C(61)/-0.030/,C(62)/2.007/,C(63)/-0.178/,C(64)/2.223/,C(65)/-0.37
     54/,C(66)/2.456/,C(67)/-0.652/,C(68)/2.713/,C(69)/-1.044/,C(70)/2.9
     673/,C(71)/-1.657/,C(72)/3.264/,C(73)/-2.951/,C(74)/3.542/,C(75)/-2
     7.965/,C(76)/0.560/,C(77)/-2.197/,C(78)/0.621/,C(79)/-1.825/,C(80)/
     80.688/
      DATA C(81)/-1.590/,C(82)/0.759/,C(83)/-1.420/,C(84)/0.836/,C(85)/-
     11.287/,C(86)/0.919/,C(87)/-1.177/,C(88)/1.007/,C(89)/-1.085/,C(90)
     2/1.101/,C(91)/-1.005/,C(92)/1.202/,C(93)/-0.936/,C(94)/1.310/,C(95
     3)/-0.873/,C(96)/1.424/,C(97)/-0.816/,C(98)/1.546/,C(99)/-0.772/,C(
     4100)/01.675/,C(101)/-0.726/,C(102)/1.812/,C(103)/-0.684/,C(104)/1.
     5958/,C(105)/-0.644/,C(106)/2.119/,C(107)/-0.613/,C(108)/2.282/,C(1
     609)/-0.588/,C(110)/2.452/,C(111)/-0.564/,C(112)/2.632/,C(113)/-0.5
     730/,C(114)/2.845/,C(115)/-0.535/,C(116)/3.018/,C(117)/-0.530/,C(11
     88)/3.225/,C(119)/-0.533/,C(120)/3.442/
      DATA C(121)/-0.542/,C(122)/3.669/,C(123)/-0.564/,C(124)/3.904/,C(1
     125)/-0.591/,C(126)/4.151/,C(127)/-0.619/,C(128)/4.410/,C(129)/-0.6
     266/,C(130)/4.678/,C(131)/-0.723/,C(132)/4.958/,C(133)/-0.795/,C(13
     34)/5.248/,C(135)/-0.884/,C(136)/5.548/,C(137)/-0.988/,C(138)/5.858
     4/,C(139)/-1.118/,C(140)/6.185/,C(141)/-1.258/,C(142)/6.523/,C(143)
     5/-1.421/,C(144)/6.872/,C(145)/-1.598/,C(146)/7.232/,C(147)/-1.816/
     6,C(148)/7.605/,C(149)/-2.066/,C(150)/7.990/,C(151)/-2.352/,C(152)/
     78.388/,C(153)/-2.688/,C(154)/8.798/,C(155)/-3.084/,C(156)/9.223/,C
     8(157)/-3.556/,C(158)/9.659/,C(159)/-4.133/,C(160)/10.102/
      DATA C(161)/-4.861/,C(162)/10.559/,C(163)/-5.924/,C(164)/11.042/,C
     1(165)/-7.444/,C(166)/9.961/,C(167)/-8.862/,C(168)/10.403/,C(169)/-
     27.912/,C(170)/7.754/,C(171)/-7.620/,C(172)/8.105/,C(173)/-7.725/,C
     3(174)/8.472/,C(175)/-8.127/,C(176)/8.870/,C(177)/-8.960/,C(178)/9.
     4284/,C(179)/-10.673/,C(180)/9.654/,C(181)/-11.158/,C(182)/4.148/,C
     5(183)/-9.725/,C(184)/4.330/,C(185)/-8.926/,C(186)/4.511/,C(187)/-8
     6.416/,C(188)/4.697/,C(189)/-7.990/,C(190)/4.908/,C(191)/-7.683/,C(
     7192)/5.107/
      DELFR=C(I)
      I=I+1
      DELFI=C(I)
      RETURN
      END
C
C-----------------------------------------------------------------------
      SUBROUTINE ARGENT (I)
C-----------------------------------------------------------------------
C
C-----CONTAINS ANOMALOUS DISPERSION CORRECTION TERMS FOR  AGK
C-----TABULATED IN THE INTERNATIONAL TABLES VOLUME 4 PAGE 149
      COMMON /ANOMAL/ DELFR,DELFI
      DIMENSION C(192)
      DATA C(1)/0.000/,C(2)/0.000/,C(3)/0.001/,C(4)/0.000/,C(5)/0.000/,C
     1(6)/0.000/,C(7)/0.000/,C(8)/0.001/,C(9)/0.001/,C(10)/0.002/,C(11)/
     20.003/,C(12)/0.004/,C(13)/0.006/,C(14)/0.006/,C(15)/0.011/,C(16)/0
     3.010/,C(17)/0.016/,C(18)/0.015/,C(19)/0.023/,C(20)/0.022/,C(21)/0.
     4032/,C(22)/0.031/,C(23)/0.042/,C(24)/0.043/,C(25)/0.055/,C(26)/0.0
     558/,C(27)/0.068/,C(28)/0.076/,C(29)/0.084/,C(30)/0.099/,C(31)/0.10
     61/,C(32)/0.125/,C(33)/0.118/,C(34)/0.156/,C(35)/0.137/,C(36)/0.193
     7/,C(37)/0.156/,C(38)/0.235/,C(39)/0.175/,C(40)/0.283/
      DATA C(41)/0.194/,C(42)/0.338/,C(43)/0.213/,C(44)/0.399/,C(45)/0.2
     129/,C(46)/0.468/,C(47)/0.244/,C(48)/0.545/,C(49)/0.256/,C(50)/0.63
     20/,C(51)/0.261/,C(52)/0.724/,C(53)/0.265/,C(54)/0.826/,C(55)/0.260
     3/,C(56)/0.938/,C(57)/0.249/,C(58)/1.059/,C(59)/0.228/,C(60)/1.190/
     4,C(61)/0.196/,C(62)/1.332/,C(63)/0.152/,C(64)/1.481/,C(65)/0.090/,
     5C(66)/1.643/,C(67)/0.008/,C(68)/1.820/,C(69)/-0.099/,C(70)/2.003/,
     6C(71)/-0.230/,C(72)/2.203/,C(73)/-0.406/,C(74)/2.411/,C(75)/-0.639
     7/,C(76)/2.630/,C(77)/-0.957/,C(78)/2.860/,C(79)/-1.416/,C(80)/3.10
     83/
      DATA C(81)/-2.205/,C(82)/3.535/,C(83)/-5.524/,C(84)/3.651/,C(85)/-
     12.649/,C(86)/0.596/,C(87)/-2.128/,C(88)/0.654/,C(89)/-1.834/,C(90)
     2/0.717/,C(91)/-1.637/,C(92)/0.783/,C(93)/-1.493/,C(94)/0.854/,C(95
     3)/-1.378/,C(96)/0.930/,C(97)/-1.284/,C(98)/1.010/,C(99)/-1.212/,C(
     4100)/1.096/,C(101)/-1.144/,C(102)/1.187/,C(103)/-1.084/,C(104)/1.2
     584/,C(105)/-1.029/,C(106)/1.391/,C(107)/-0.983/,C(108)/1.500/,C(10
     69)/-0.942/,C(110)/1.615/,C(111)/-0.904/,C(112)/1.735/,C(113)/-0.85
     79/,C(114)/1.873/,C(115)/-0.842/,C(116)/1.995/,C(117)/-0.818/,C(118
     8)/2.135/,C(119)/-0.798/,C(120)/2.281/
      DATA C(121)/-0.782/,C(122)/2.435/,C(123)/-0.774/,C(124)/2.595/,C(1
     125)/-0.767/,C(126)/2.764/,C(127)/-0.761/,C(128)/2.940/,C(129)/-0.7
     265/,C(130)/3.124/,C(131)/-0.773/,C(132)/3.316/,C(133)/-0.790/,C(13
     34)/3.515/,C(135)/-0.815/,C(136)/3.723/,C(137)/-0.847/,C(138)/3.937
     4/,C(139)/-0.890/,C(140)/4.164/,C(141)/-0.937/,C(142)/4.399/,C(143)
     5/-0.993/,C(144)/4.643/,C(145)/-1.048/,C(146)/4.894/,C(147)/-1.127/
     6,C(148)/5.156/,C(149)/-1.216/,C(150)/5.427/,C(151)/-1.319/,C(152)/
     75.708/,C(153)/-1.438/,C(154)/5.998/,C(155)/-1.576/,C(156)/6.299/,C
     8(157)/-1.730/,C(158)/6.610/,C(159)/-1.910/,C(160)/6.930/
      DATA C(161)/-2.116/,C(162)/7.258/,C(163)/-2.353/,C(164)/7.600/,C(1
     165)/-2.630/,C(166)/7.949/,C(167)/-2.932/,C(168)/8.308/,C(169)/-3.2
     285/,C(170)/8.674/,C(171)/03.702/,C(172)/9.047/,C(173)/-4.192/,C(17
     34)/9.428/,C(175)/-4.784/,C(176)/9.819/,C(177)/-5.555/,C(178)/10.22
     47/,C(179)/-6.735/,C(180)/10.637/,C(181)/-7.842/,C(182)/9.570/,C(18
     53)/-8.473/,C(184)/6.999/,C(185)/-7.701/,C(186)/7.296/,C(187)/-7.38
     68/,C(188)/7.589/,C(189)/-7.485/,C(190)/7.931/,C(191)/-7.638/,C(192
     7)/8.246/
      DELFR=C(I)
      I=I+1
      DELFI=C(I)
      RETURN
      END
