C   FORMULA.FOR
C   ***********
C   A FORTRAN 77 coded program which calculates the structural
C   formula unit of a mineral from its chemical composition.
C   The program accepts as INPUT both, oxides or elements.
C   Dr. George Tsambourakis, CSIRO, Division of Mineral Products,
C   Port Melbourne, Victoria 3207, Australia.  March 1993.
C  ********************************************************
      INTEGER IN,OUT,REF,RESULT,OXYGN,OXGN
      PARAMETER (IN=5, OUT=6, REF=9, RESULT=10)
      REAL MOLWT, ML
      CHARACTER*1 ANSWER
      CHARACTER*2 ELMNT(80), YTITLE(80), ELEMEN
      CHARACTER*5 VAL(73), XVAL, VAL2(20), XTITLE(20)
      CHARACTER*5 OXDES(73), TITLEX
      CHARACTER*30 NAME
      DIMENSION R1(20), R2(20), R3(20), CT(20), WTP(20)
      DIMENSION AWTT(20), WTPA(20), CAT_O(73)
      DIMENSION MOLWT(73), OXYGN(73), ML(73), AWT(80)
C  ***************************************************************
C  OXDES - OXiDES analysed;    ML    - MoLecular weights;
C  OXYGN - Number of OXYGeNs;  CAT_O - Cation:oxygen RAtio;
C  VAL - cation VALancies;  OXGN - No of Oxygens per formula unit:
C  ***************************************************************
      DATA OXDES(1),ML(1),OXYGN(1),CAT_O(1),VAL(1)/'As2O5',
     &229.8402,5,0.4,'As5+ '/
      DATA OXDES(2),ML(2),OXYGN(2),CAT_O(2),VAL(2)/'Nb2O5',
     &265.8096,5,0.4,'Nb5+ '/
      DATA OXDES(3),ML(3),OXYGN(3),CAT_O(3),VAL(3)/'P2O5 ',
     &141.9444,5,0.4,'P5+  '/
      DATA OXDES(4),ML(4),OXYGN(4),CAT_O(4),VAL(4)/'Sb2O5',
     &323.497,5,0.4,'Sb5+ '/
      DATA OXDES(5),ML(5),OXYGN(5),CAT_O(5),VAL(5)/'Ta2O5',
     &441.8928,5,0.4,'Ta5+ '/
      DATA OXDES(6),ML(6),OXYGN(6),CAT_O(6),VAL(6)/'V2O5 ',
     &181.88,5,0.4,'V5+  '/
      DATA OXDES(7),ML(7),OXYGN(7),CAT_O(7),VAL(7)/'Al2O3',
     &101.9612,3,0.66667,'Al3+ '/
      DATA OXDES(8),ML(8),OXYGN(8),CAT_O(8),VAL(8)/'As2O3',
     &197.8414,3,0.66667,'As3+ '/
      DATA OXDES(9),ML(9),OXYGN(9),CAT_O(9),VAL(9)/'B2O3 ',
     &69.619,3,0.66667,'B3+  '/
      DATA OXDES(10),ML(10),OXYGN(10),CAT_O(10),VAL(10)/'Bi2O3',
     &465.959,3,0.66667,'Bi3+ '/
      DATA OXDES(11),ML(11),OXYGN(11),CAT_O(11),VAL(11)/'Ce2O3',
     &328.227,3,0.66667,'Ce3+ '/
      DATA OXDES(12),ML(12),OXYGN(12),CAT_O(12),VAL(12)/'Cr2O3',
     &151.9904,3,0.66667,'Cr3+ '/
      DATA OXDES(13),ML(13),OXYGN(13),CAT_O(13),VAL(13)/'Dy2O3',
     &372.97,3,0.66667,'Dy3+ '/
      DATA OXDES(14),ML(14),OXYGN(14),CAT_O(14),VAL(14)/'Er2O3',
     &382.49,3,0.66667,'Er3+ '/
      DATA OXDES(15),ML(15),OXYGN(15),CAT_O(15),VAL(15)/'Eu2O3',
     &351.927,3,0.66667,'Eu3+ '/
      DATA OXDES(16),ML(16),OXYGN(16),CAT_O(16),VAL(16)/'Fe2O3',
     &159.691,3,0.66667,'Fe3+ '/
      DATA OXDES(17),ML(17),OXYGN(17),CAT_O(17),VAL(17)/'Ga2O3',
     &187.443,3,0.66667,'Ga3+ '/
      DATA OXDES(18),ML(18),OXYGN(18),CAT_O(18),VAL(18)/'Gd2O3',
     &362.47,3,0.66667,'Gd3+ '/
      DATA OXDES(19),ML(19),OXYGN(19),CAT_O(19),VAL(19)/'Ho2O3',
     &377.8588,3,0.66667,'Ho3+ '/
      DATA OXDES(20),ML(20),OXYGN(20),CAT_O(20),VAL(20)/'La2O3',
     &325.8092,3,0.66667,'La3+ '/
      DATA OXDES(21),ML(21),OXYGN(21),CAT_O(21),VAL(21)/'Lu2O3',
     &397.931,3,0.66667,'Lu3+ '/
      DATA OXDES(22),ML(22),OXYGN(22),CAT_O(22),VAL(22)/'Nd2O3',
     &336.45,3,0.66667,'Nd3+ '/
      DATA OXDES(23),ML(23),OXYGN(23),CAT_O(23),VAL(23)/'Pm2O3',
     &337.8236,3,0.66667,'Pm3+ '/
      DATA OXDES(24),ML(24),OXYGN(24),CAT_O(24),VAL(24)/'Pr2O3',
     &329.8134,3,0.66667,'Pr3+ '/
      DATA OXDES(25),ML(25),OXYGN(25),CAT_O(25),VAL(25)/'Sb2O3',
     &291.497,3,0.66667,'Sb3+ '/
      DATA OXDES(26),ML(26),OXYGN(26),CAT_O(26),VAL(26)/'Sc2O3',
     &137.91,3,0.66667,'Sc3+ '/
      DATA OXDES(27),ML(27),OXYGN(27),CAT_O(27),VAL(27)/'Sm2O3',
     &348.69,3,0.66667,'Sm3+ '/
      DATA OXDES(28),ML(28),OXYGN(28),CAT_O(28),VAL(28)/'Tb2O3',
     &365.8488,3,0.66667,'Tb3+ '/
      DATA OXDES(29),ML(29),OXYGN(29),CAT_O(29),VAL(29)/'Tm2O3',
     &385.8666,3,0.66667,'Tm3+ '/
      DATA OXDES(30),ML(30),OXYGN(30),CAT_O(30),VAL(30)/'V2O3 ',
     &149.8812,3,0.66667,'V3+  '/
      DATA OXDES(31),ML(31),OXYGN(31),CAT_O(31),VAL(31)/'Y2O3 ',
     &225.8098,3,0.66667,'Y3+  '/
      DATA OXDES(32),ML(32),OXYGN(32),CAT_O(32),VAL(32)/'Yb2O3',
     &394.05,3,0.66667,'Yb3+ '/
      DATA OXDES(33),ML(33),OXYGN(33),CAT_O(33),VAL(33)/'MoO3 ',
     &143.937,3,0.3333,'Mo6+ '/
      DATA OXDES(34),ML(34),OXYGN(34),CAT_O(34),VAL(34)/'SO3  ',
     &80.063,3,0.3333,'S6+  '/
      DATA OXDES(35),ML(35),OXYGN(35),CAT_O(35),VAL(35)/'WO3  ',
     &231.82,3,0.3333,'W6+  '/
      DATA OXDES(36),ML(36),OXYGN(36),CAT_O(36),VAL(36)/'CO2  ',
     &44.009,2,0.5,'C4+  '/
      DATA OXDES(37),ML(37),OXYGN(37),CAT_O(37),VAL(37)/'GeO2 ',
     &104.59,2,0.5,'Ge4+ '/
      DATA OXDES(38),ML(38),OXYGN(38),CAT_O(38),VAL(38)/'HfO2 ',
     &210.47,2,0.5,'Hf4+ '/
      DATA OXDES(39),ML(39),OXYGN(39),CAT_O(39),VAL(39)/'MnO2 ',
     &86.9368,2,0.5,'Mn4+ '/
      DATA OXDES(40),ML(40),OXYGN(40),CAT_O(40),VAL(40)/'MoO2 ',
     &127.9388,2,0.5,'Mo4+ '/
      DATA OXDES(41),ML(41),OXYGN(41),CAT_O(41),VAL(41)/'SeO2 ',
     &110.94,2,0.5,'Se4+ '/
      DATA OXDES(42),ML(42),OXYGN(42),CAT_O(42),VAL(42)/'SiO2 ',
     &60.0843,2,0.5,'Si4+ '/
      DATA OXDES(43),ML(43),OXYGN(43),CAT_O(43),VAL(43)/'SnO2 ',
     &150.708,2,0.5,'Sn4+ '/
      DATA OXDES(44),ML(44),OXYGN(44),CAT_O(44),VAL(44)/'TeO2 ',
     &159.58,2,0.5,'Te4+ '/
      DATA OXDES(45),ML(45),OXYGN(45),CAT_O(45),VAL(45)/'ThO2 ',
     &264.0369,2,0.5,'Th4+ '/
      DATA OXDES(46),ML(46),OXYGN(46),CAT_O(46),VAL(46)/'TiO2 ',
     &79.86,2,0.5,'Ti4+ '/
      DATA OXDES(47),ML(47),OXYGN(47),CAT_O(47),VAL(47)/'UO2  ',
     &270.0277,2,0.5,'U4+  '/
      DATA OXDES(48),ML(48),OXYGN(48),CAT_O(48),VAL(48)/'ZrO2 ',
     &123.222,2,0.5,'Zr4+ '/
      DATA OXDES(49),ML(49),OXYGN(49),CAT_O(49),VAL(49)/'Cs2O ',
     &281.8102,1,2,'Cs+  '/
      DATA OXDES(50),ML(50),OXYGN(50),CAT_O(50),VAL(50)/'Cu2O ',
     &143.091,1,2,'Cu+  '/
      DATA OXDES(51),ML(51),OXYGN(51),CAT_O(51),VAL(51)/'H2O+ ',
     &18.0152,1,2,'(OH)-'/
      DATA OXDES(52),ML(52),OXYGN(52),CAT_O(52),VAL(52)/'H2O- ',
     &18.0152,1,2,'H2O- '/
      DATA OXDES(53),ML(53),OXYGN(53),CAT_O(53),VAL(53)/'K2O  ',
     &94.196,1,2,'K+   '/
      DATA OXDES(54),ML(54),OXYGN(54),CAT_O(54),VAL(54)/'Li2O ',
     &29.881,1,2,'Li+  '/
      DATA OXDES(55),ML(55),OXYGN(55),CAT_O(55),VAL(55)/'Na2O ',
     &61.9788,1,2,'Na+  '/
      DATA OXDES(56),ML(56),OXYGN(56),CAT_O(56),VAL(56)/'Rb2O ',
     &186.935,1,2,'Rb+  '/
      DATA OXDES(57),ML(57),OXYGN(57),CAT_O(57),VAL(57)/'BaO  ',
     &153.326,1,1,'Ba2+ '/
      DATA OXDES(58),ML(58),OXYGN(58),CAT_O(58),VAL(58)/'BeO  ',
     &25.0116,1,1,'Be2+ '/
      DATA OXDES(59),ML(59),OXYGN(59),CAT_O(59),VAL(59)/'CaO  ',
     &56.077,1,1,'Ca2+ '/
      DATA OXDES(60),ML(60),OXYGN(60),CAT_O(60),VAL(60)/'CdO  ',
     &128.41,1,1,'Cd2+ '/
      DATA OXDES(61),ML(61),OXYGN(61),CAT_O(61),VAL(61)/'CoO  ',
     &74.9326,1,1,'Co2+ '/
      DATA OXDES(62),ML(62),OXYGN(62),CAT_O(62),VAL(62)/'CuO  ',
     &79.545,1,1,'Cu2+ '/
      DATA OXDES(63),ML(63),OXYGN(63),CAT_O(63),VAL(63)/'FeO  ',
     &71.846,1,1,'Fe2+ '/
      DATA OXDES(64),ML(64),OXYGN(64),CAT_O(64),VAL(64)/'HgO  ',
     &216.589,1,1,'Hg2+ '/
      DATA OXDES(65),ML(65),OXYGN(65),CAT_O(65),VAL(65)/'MnO  ',
     &70.9374,1,1,'Mn2+ '/
      DATA OXDES(66),ML(66),OXYGN(66),CAT_O(66),VAL(66)/'MgO  ',
     &40.3044,1,1,'Mg2+ '/
      DATA OXDES(67),ML(67),OXYGN(67),CAT_O(67),VAL(67)/'NiO  ',
     &74.69,1,1,'Ni2+ '/
      DATA OXDES(68),ML(68),OXYGN(68),CAT_O(68),VAL(68)/'PbO  ',
     &223.19,1,1,'Pb2+ '/
      DATA OXDES(69),ML(69),OXYGN(69),CAT_O(69),VAL(69)/'SrO  ',
     &103.61,1,1,'Sr2+ '/
      DATA OXDES(70),ML(70),OXYGN(70),CAT_O(70),VAL(70)/'ZnO  ',
     &81.38,1,1,'Zn2+ '/
      DATA OXDES(71),ML(71),OXYGN(71),CAT_O(71),VAL(71)/'Br-  ',
     &79.904,0,0,'Br-  '/
      DATA OXDES(72),ML(72),OXYGN(72),CAT_O(72),VAL(72)/'Cl-  ',
     &35.4527,0,0,'Cl-  '/
      DATA OXDES(73),ML(73),OXYGN(73),CAT_O(73),VAL(73)/'F-   ',
     &18.9984,0,0,'F-   '/
C  ***********************
C  ELMNT - ELeMeNTs
C  *************************************
      DATA ELMNT(1),AWT(1)/'Ag',107.868/
      DATA ELMNT(2),AWT(2)/'Al',26.98154/
      DATA ELMNT(3),AWT(3)/'As',74.92159/
      DATA ELMNT(4),AWT(4)/'Au',196.9665/
      DATA ELMNT(5),AWT(5)/'B ',10.81/
      DATA ELMNT(6),AWT(6)/'Ba',137.327/ 
      DATA ELMNT(7),AWT(7)/'Be',9.01218/
      DATA ELMNT(8),AWT(8)/'Bi',208.98037/
      DATA ELMNT(9),AWT(9)/'Br',79.904/
      DATA ELMNT(10),AWT(10)/'C ',12.011/
      DATA ELMNT(11),AWT(11)/'Ca',40.078/
      DATA ELMNT(12),AWT(12)/'Cd',112.411/
      DATA ELMNT(13),AWT(13)/'Ce',140.115/
      DATA ELMNT(14),AWT(14)/'Cl',35.4527/
      DATA ELMNT(15),AWT(15)/'Co',58.93320/
      DATA ELMNT(16),AWT(16)/'Cr',51.9961/
      DATA ELMNT(17),AWT(17)/'Cs',132.90543/
      DATA ELMNT(18),AWT(18)/'Cu',63.546/
      DATA ELMNT(19),AWT(19)/'Dy',162.50/
      DATA ELMNT(20),AWT(20)/'Er',167.26/
      DATA ELMNT(21),AWT(21)/'Eu',151.965/
      DATA ELMNT(22),AWT(22)/'F ',18.998403/
      DATA ELMNT(23),AWT(23)/'Fe',55.847/
      DATA ELMNT(24),AWT(24)/'Ga',69.723/
      DATA ELMNT(25),AWT(25)/'Gd',157.25/
      DATA ELMNT(26),AWT(26)/'Ge',72.61/
      DATA ELMNT(27),AWT(27)/'H ',1.00797/
      DATA ELMNT(28),AWT(28)/'Hf',178.49/
      DATA ELMNT(29),AWT(29)/'Hg',200.59/
      DATA ELMNT(30),AWT(30)/'Ho',164.9303/
      DATA ELMNT(31),AWT(31)/'In',114.82/
      DATA ELMNT(32),AWT(32)/'Ir',192.22/
      DATA ELMNT(33),AWT(33)/'J ',126.90447/
      DATA ELMNT(34),AWT(34)/'K ',39.0983/
      DATA ELMNT(35),AWT(35)/'La',138.9055/
      DATA ELMNT(36),AWT(36)/'Li',6.941/
      DATA ELMNT(37),AWT(37)/'Lu',174.967/
      DATA ELMNT(38),AWT(38)/'Mg',24.305/
      DATA ELMNT(39),AWT(39)/'Mn',54.93805/
      DATA ELMNT(40),AWT(40)/'Mo',95.94/
      DATA ELMNT(41),AWT(41)/'N ',14.00674/
      DATA ELMNT(42),AWT(42)/'Na',22.989768/
      DATA ELMNT(43),AWT(43)/'Nb',92.9064/
      DATA ELMNT(44),AWT(44)/'Nd',144.24/
      DATA ELMNT(45),AWT(45)/'Ni',58.69/
      DATA ELMNT(46),AWT(46)/'O ',15.9994/
      DATA ELMNT(47),AWT(47)/'Os',190.2/
      DATA ELMNT(48),AWT(48)/'P ',30.97376/
      DATA ELMNT(49),AWT(49)/'Pb',207.2/
      DATA ELMNT(50),AWT(50)/'Pd',106.42/
      DATA ELMNT(51),AWT(51)/'Pm',144.9127/
      DATA ELMNT(52),AWT(52)/'Pr',140.90765/
      DATA ELMNT(53),AWT(53)/'Pt',195.08/
      DATA ELMNT(54),AWT(54)/'Rb',85.4678/
      DATA ELMNT(55),AWT(55)/'Re',186.207/
      DATA ELMNT(56),AWT(56)/'Ru',101.07/
      DATA ELMNT(57),AWT(57)/'Rh',102.9055/
      DATA ELMNT(58),AWT(58)/'S ',32.066/
      DATA ELMNT(59),AWT(59)/'Sb',121.75/
      DATA ELMNT(60),AWT(60)/'Sc',44.9559/
      DATA ELMNT(61),AWT(61)/'Se',78.96/
      DATA ELMNT(62),AWT(62)/'Si',28.0855/
      DATA ELMNT(63),AWT(63)/'Sm',150.36/
      DATA ELMNT(64),AWT(64)/'Sn',118.71/
      DATA ELMNT(65),AWT(65)/'Sr',87.62/
      DATA ELMNT(66),AWT(66)/'Ta',180.9479/
      DATA ELMNT(67),AWT(67)/'Tb',158.92534/
      DATA ELMNT(68),AWT(68)/'Tc',97.907/
      DATA ELMNT(69),AWT(69)/'Te',127.6/
      DATA ELMNT(70),AWT(70)/'Tm',168.9342/
      DATA ELMNT(71),AWT(71)/'Th',232.038/
      DATA ELMNT(72),AWT(72)/'Ti',47.88/
      DATA ELMNT(73),AWT(73)/'Tl',204.383/
      DATA ELMNT(74),AWT(74)/'U ',238.0289/
      DATA ELMNT(75),AWT(75)/'V ',50.9415/
      DATA ELMNT(76),AWT(76)/'Yb',173.04/
      DATA ELMNT(77),AWT(77)/'W ',183.85/
      DATA ELMNT(78),AWT(78)/'Y ',88.90585/
      DATA ELMNT(79),AWT(79)/'Zn',65.39/
      DATA ELMNT(80),AWT(80)/'Zr',91.224/
C  **************************************
C  *****************
C  FORMAT STATEMENTS
C  *****************
C  ************************************************************
20    FORMAT(/'***  IS THE INPUT:  OXIDES  OR  ELEMENTS  ***'/)
30    FORMAT(' Type ONE (1)    OXIDES'/
     &' Type TWO (2)    ELEMENTS')
40    FORMAT(I1)
50    FORMAT(/' Mineral name: ?')
60    FORMAT(A)
70    FORMAT(/' How many elements have been analyzed: ?')
80    FORMAT(I2)
90    FORMAT(/' Oxides and wt.%.(A6,F8.3)')
100   FORMAT(10X,' No oxide called ',A,' in data ')
110   FORMAT(/' Do you want to try again (Y/y))?')
120   FORMAT(/' No of oxygens atoms per formula unit.')
130   FORMAT(A,F8.3)
140   FORMAT(//5X,' M i n e r a l  N a m e: ',A)
150   FORMAT(//1X,' M i n e r a l  N a m e: ',A)
160   FORMAT(6X,41('*'))
165   FORMAT(6X,29('*'))
170   FORMAT(1X,69('*'))
180   FORMAT(1X,23('*'),5X,17('*'),5X,19('*'))
190   FORMAT(6X,'Oxides',4X,'wt.%',6X,'Cat. per Formula Unit')
200   FORMAT(6X,A,F9.3,8X,A,2X,F9.3)
210   FORMAT(13X,'-------')
220   FORMAT(5X,' Total',F9.3)
225   FORMAT(5X,' - O=F  =' ,F6.3)
230   FORMAT(5X,' - O=Cl =' ,F6.3)
235   FORMAT(5X,' - O=Br =' ,F6.3)
240   FORMAT(/5X' Assumed number of Oxygens: ' ,I2)
250   FORMAT(/' Cations wt.%(A3,F8.3)')
260   FORMAT(/5X,' No element called ',A,' in data')
270   FORMAT(/' Do you want to try again (Y/y)?')
280   FORMAT(' Standard calculation',7X,' Total wt.% = 100',
     &6X,'Cat.:wt.% Ratio = 1')
290   FORMAT(1X,'Elements',2X,'wt.%',2X,'Cat.wt.%',5X,
     &'wt.%',4X,'Cat.wt.%',7X,'wt.%',5X,'Cat:wt.%'/)
300   FORMAT(1X,A,6X,F6.3,2X,F6.3,7X,F6.3,3X,F6.3,8X,
     &F6.3,3X,F6.3)
310   FORMAT(8X,'-------',2X,'------',6X,'-------',3X,
     &'------',7X,'-------',3X,'------')
320   FORMAT(' TOTAL',2X,F7.3,3X,F5.3,6X,F7.3,4X,F5.3,
     &7X,F7.3,3X,F6.3/)
C  *******************************
C  **  M A I N	 P R O G R A M	**
C  *******************************
      DO 1 K=1,73
      MOLWT(K)=ML(K)
1     CONTINUE
      SUM1=0.00
      SUM2=0.00
      SUM3=0.00
      SUM4=0.00
      SUM5=0.00
      SUM6=0.00
      P1=0.00
      P2=0.00
      P3=0.00
      P4=0.00
      SX=0.00
      SY=0.00
      SZ=0.00
      EQUIVO=0.00
      ADJ=0.00
      WRITE(OUT,20)
      WRITE(OUT,30)
      READ(IN,40) METHOD
      WRITE(OUT,50)
      READ(IN,60)NAME
      WRITE(OUT,70)
      READ(IN,80)NUM
      IF (METHOD.EQ.2) GOTO 2000
      CONTINUE
C   ***************************
C   FIRST OPTION:
c   Input OXIDES:
C   ******************************************
      WRITE(OUT,120)
      READ(IN,80)OXGN
      WRITE(OUT,90)
      DO 6 IJ=1,NUM
2     READ(IN,130)TITLEX,WTPER
      DO 3 I=1,73
      NUMCOM=I
      IF(TITLEX.EQ.OXDES(I)) GOTO 4
3     CONTINUE
      WRITE(OUT,100)TITLEX
      WRITE(OUT,110)
      READ(IN,60)ANSWER
      IF(ANSWER.EQ.'Y'.OR.ANSWER.EQ.'y') GOTO 2
      STOP
4     CONTINUE
      SUM1=SUM1+WTPER
      IF (NUMCOM.EQ.52) GOTO 5
C  ************
C  CALCULATIONS
C  ************
      XMW=MOLWT(NUMCOM)
      XOG=OXYGN(NUMCOM)
      XCAT=CAT_O(NUMCOM)
      XVAL=VAL(NUMCOM)
      RES1=WTPER/XMW
      RES2=RES1*XOG
      IF (XOG.EQ.0.0) RES2=RES1
      SUM2=SUM2+RES2
C  *******************************
C  ADJUSTMENTS FOR F-, Cl- AND Br-
C  *******************************
      IF (TITLEX.EQ.OXDES(71)) THEN
	 SZ=0.1001*WTPER
	 FCB1=0.5*(WTPER/XMW)
      END IF
      IF (TITLEX.EQ.OXDES(72)) THEN
	 SY=0.2256*WTPER
	 FCB2=0.5*(WTPER/XMW)
      END IF
      IF (TITLEX.EQ.OXDES(73)) THEN
	 SX=0.4211*WTPER
	 FCB3=0.5*(WTPER/XMW)
      END IF
      EQUIVO=SX+SY+SZ
      ADJ=FCB1+FCB2+FCB3
5     CONTINUE
      VAL2(IJ)=XVAL
      CT(IJ)=XCAT
      XTITLE(IJ)=TITLEX
      WTP(IJ)=WTPER
      R1(IJ)=RES2
6     CONTINUE
      SUM3=SUM1-EQUIVO
      SUM4=SUM2-ADJ
      RATIO=OXGN/SUM4
      OPEN (UNIT=RESULT, FILE='OXIDE.OUT')
      WRITE(RESULT,140)NAME
      WRITE(RESULT,160)
      WRITE(RESULT,190)
      WRITE(RESULT,160)
      DO 8 IJ=1,NUM
      IF (XTITLE(IJ).EQ.OXDES(48)) GOTO 7
      R2(IJ)=R1(IJ)*RATIO
      R3(IJ)=R2(IJ)*CT(IJ)
      IF (CT(IJ).EQ.0.00) R3(IJ)=R2(IJ)
      WRITE(RESULT,200)XTITLE(IJ),WTP(IJ),VAL2(IJ),R3(IJ)
      GOTO 8
7     WRITE(RESULT,200)XTITLE(IJ),WTP(IJ)
8     CONTINUE
      WRITE(RESULT,210)
      WRITE(RESULT,220)SUM1
      IF (EQUIVO.LT.0.00) GOTO 9
      IF (SX.GT.0.00) WRITE(RESULT,225)SX
      IF (SY.GT.0.00) WRITE(RESULT,230)SY
      IF (SZ.GT.0.00) WRITE(RESULT,235)SZ
      WRITE(RESULT,210)
9     CONTINUE
      IF(SUM3.EQ.SUM1) GOTO 10
      WRITE(RESULT,220)SUM3
10    CONTINUE
      WRITE(RESULT,240)OXGN
      WRITE(RESULT,165)
      STOP
C  ***************
C  SECOND OPTION:
C  Input: ELEMENTS
C  ***************
2000  CONTINUE
      WRITE(OUT,250)
      DO 14  IJ=1,NUM
11    CONTINUE
      READ(IN,130)ELEMEN,WTPER
      DO 12  I=1,80
      NUMCOM=I
      IF (ELEMEN.EQ.ELMNT(I)) GOTO 13
12    CONTINUE
      WRITE(OUT,260)ELEMEN
      WRITE(OUT,270)
      READ(IN,60)ANSWER
      IF (ANSWER.EQ.'Y'.OR.ANSWER.EQ.'y') GOTO 11
      STOP
13    CONTINUE
      YTITLE(IJ)=ELEMEN
      WTP(IJ)=WTPER
      SUM1=SUM1+WTPER
      AWTT(IJ)=AWT(NUMCOM)
      P1=WTP(IJ)/AWTT(IJ)
      SUM2=SUM2+P1
14    CONTINUE
      OPEN (UNIT=RESULT, FILE= 'ELEMENT.OUT')
      WRITE(RESULT,150)NAME
      WRITE(RESULT,170)
      WRITE(RESULT,280)
      WRITE(RESULT,180)
      WRITE(RESULT,290)
      DO 15  IJ=1,NUM
      WTPA(IJ)=WTP(IJ)*100/SUM1
      P1=WTP(IJ)/AWTT(IJ)
      P2=WTPA(IJ)
      P3=WTPA(IJ)/AWTT(IJ)
      P4=P1/SUM2
      SUM3=SUM3+P2
      SUM4=SUM4+P3
      SUM5=SUM1
      SUM6=SUM6+P4
      WRITE(RESULT,300)YTITLE(IJ),WTP(IJ),P1,P2,P3,WTP(IJ),P4
15    CONTINUE
      WRITE(RESULT,310)
      WRITE(RESULT,320)SUM1,SUM2,SUM3,SUM4,SUM5,SUM6
      WRITE(RESULT,170)
      STOP
      END
