C  FORTRAN 77 PROGRAM, VERSION 15/02/1992
C  BARTH MOLECULAR EQUIVALENT NORM (MESONORM) FOR METAMORPHIC AND
C  GRANITIC ROCKS.
C  After Barth 1962a, modified by Hutchison & Jeacoke 1971, Mielke &
C  Winkler (1979) and own.
C  *****************************************************************
c$DEBUG
      INTEGER IN, OUT, REF, RESULT, OXOUT(36), NOXOUT
      PARAMETER (IN=5, OUT=6, REF=9, RESULT=10)
      REAL MT, KS, NS, IL, NE, MON, MU, MUSCO,MINOUT(40)
      CHARACTER*1 ANSWER, SUL, BIOT
      CHARACTER*3 MINNAM(40)
      CHARACTER*5 OXIDE(36), TITLEX
      CHARACTER*30 NAME
      DIMENSION WTP(36), V(22), EQMOL(36), CATPC(36)
C   **********************************************************
C   WTP    - WeighT Percent
C   OXIDE  - OXIDE analysed.
C   EQMOL  - EQuivalent MOLecular weight values.
C   CATPC  - CATion PerCent
C   MINOUT - MINeral OUTput
C   ********************************************
      DATA OXIDE(1),EQMOL(1)/'SiO2 ',60.0843  /
      DATA OXIDE(2),EQMOL(2)/'TiO2 ',79.8988  /
      DATA OXIDE(3),EQMOL(3)/'Al2O3',50.98064 /
      DATA OXIDE(4),EQMOL(4)/'Fe2O3',79.8461  /
      DATA OXIDE(5),EQMOL(5)/'FeO  ',71.8464  /
      DATA OXIDE(6),EQMOL(6)/'MnO  ',70.9374  /
      DATA OXIDE(7),EQMOL(7)/'NiO  ',74.6994  /
      DATA OXIDE(8),EQMOL(8)/'MgO  ',40.3044  /
      DATA OXIDE(9),EQMOL(9)/'CaO  ',56.0794  /
      DATA OXIDE(10),EQMOL(10)/'BaO  ',153.3294 /
      DATA OXIDE(11),EQMOL(11)/'SrO  ',103.6194 /
      DATA OXIDE(12),EQMOL(12)/'Na2O ',30.98947 /
      DATA OXIDE(13),EQMOL(13)/'K2O  ',47.098	/
      DATA OXIDE(14),EQMOL(14)/'P2O5 ',70.97226 /
      DATA OXIDE(15),EQMOL(15)/'F-   ',18.998403/
      DATA OXIDE(16),EQMOL(16)/'Cl-  ',35.453	/
      DATA OXIDE(17),EQMOL(17)/'S    ',32.06	/
      DATA OXIDE(18),EQMOL(18)/'CO2  ',44.0098	/
      DATA OXIDE(19),EQMOL(19)/'ZrO2 ',123.2188 /
      DATA OXIDE(20),EQMOL(20)/'SnO2 ',150.6888 /
      DATA OXIDE(21),EQMOL(21)/'Cr2O3',75.9951	/
      DATA OXIDE(22),EQMOL(22)/'CuO  ',79.5454	/
      DATA OXIDE(23),EQMOL(23)/'ZnO  ',81.3794	/
      DATA OXIDE(24),EQMOL(24)/'Li2O ',14.9407	/
      DATA OXIDE(25),EQMOL(25)/'SO3  ',80.0582	/
      DATA OXIDE(26),EQMOL(26)/'H2O+ ',9.0076	/
      DATA OXIDE(27),EQMOL(27)/'H2O- ',9.0076	/
      DATA OXIDE(28),EQMOL(28)/'V2O3 ',74.9406	/
      DATA OXIDE(29),EQMOL(29)/'CoO  ',74.9326	/
      DATA OXIDE(30),EQMOL(30)/'Rb2O ',93.4675	/
      DATA OXIDE(31),EQMOL(31)/'Cs2O ',140.9051 /
      DATA OXIDE(32),EQMOL(32)/'HfO2 ',210.4888 /
      DATA OXIDE(33),EQMOL(33)/'Y2O3 ',112.905	/
      DATA OXIDE(34),EQMOL(34)/'Ce2O3',164.1191 /
      DATA OXIDE(35),EQMOL(35)/'La2O3',162.9046 /
      DATA OXIDE(36),EQMOL(36)/'H2O  ',9.0076	/
      DO 1 K=1,36
1     CONTINUE
      SUM=0.0
      SUM1=0.0
      WRITE(OUT,10)
10    FORMAT(/' Sample Name or No: ? ')
      READ(IN,20) NAME
20    FORMAT(A)
      WRITE(OUT,30)
30    FORMAT(/' How many elements have been analyzed: ?')
      READ(IN,40) NUM
40    FORMAT(I2)
      WRITE(OUT,50)
50    FORMAT(/' Oxides and Wt-%(A6,F8.3)'/)
      DO 5 IJ=1,NUM
2     READ(IN,60)TITLEX,WTPER
60    FORMAT(A,F8.4)
      DO 3 I=1,36
      NUMCOM=I
      IF(TITLEX.EQ.OXIDE(I)) GOTO 4
3     CONTINUE
      WRITE(OUT,70)TITLEX
70    FORMAT(10X,20H No compound called	,A,8H in data)
      WRITE(OUT,80)
80    FORMAT(/' Do you want to try again (Y/y))?')
      READ(IN,90) ANSWER
90    FORMAT(A)
      IF(ANSWER.EQ.'Y'.OR.ANSWER.EQ.'y') GOTO 2
      STOP
4     CONTINUE
      SUM1=SUM1+WTPER
      WTP(NUMCOM)=WTPER
5     CONTINUE
      WRITE(OUT,95)
95    FORMAT(/' Do you want to calculate Biotite (Y/y))?')
      READ(IN,96) BIOT
96    FORMAT(A)
      WRITE(OUT,98)
98    FORMAT(/' Do you want to calculate Muscovite (Y/y))?')
      READ(IN,96) MUSCO
      OPEN (UNIT=RESULT, FILE= 'MNORM.OUT')
      WRITE(RESULT,100)NAME
100   FORMAT(2X,' S A M P L E: ',A)
      WRITE(RESULT,1000)
1000  FORMAT(1X,73('*'))
      WRITE(RESULT,120)
120   FORMAT(3X,'OXIDES',4X,'wt-%',4X,'OXIDES',4X,'wt-%',4X,'OXIDES',
     1 4X,'wt-%',4X,'OXIDES',4X,'wt-%',/)
      NOXOUT=0
      DO 6 I=1,36
      CATPC(I)=(1000*WTP(I))/EQMOL(I)
      CATPC(26)=0
      CATPC(27)=0
      CATPC(36)=0
      SUM=SUM+CATPC(I)
6     CONTINUE
      DO 7 IJ=1,36
      CATPC(IJ)=(100*CATPC(IJ))/SUM
      IF (WTP(IJ).NE.0) THEN
      NOXOUT=NOXOUT+1
      OXOUT(NOXOUT)=IJ
      ENDIF
7     CONTINUE
      WRITE(RESULT,140)(OXIDE(OXOUT(I)),WTP(OXOUT(I)), I=1,NOXOUT)
140   FORMAT(3X,A,F9.3,4X,A,F9.3,4X,A,F9.3,4X,A,F9.3)
      WRITE(RESULT,160)SUM1
160   FORMAT(/,2X,6H TOTAL,F9.3)
      WRITE(RESULT,170)
170   FORMAT(//,3X,'M E S O N O R M      C O M P L E T E   D A T A   O U
     1 T P U T')
      WRITE(RESULT,1000)
      IF (CATPC(25).GT.0) THEN
       WRITE(OUT,180)
180    FORMAT(/' Do you want to convert SO3 to S (Y/y))?')
       READ(IN,185)SUL
185    FORMAT(A)
       IF (SUL.EQ.'Y'.OR.SUL.EQ.'y') CATPC(17)=CATPC(25)*0.4004586663
      END IF
C   **************************
c	  V - Values
C   **************************
      V(1)=CATPC(1)
C   V(1) = SiO2
      V(2)=CATPC(2)
C   V(2) = TiO2
      V(3)=CATPC(3)
C   V(3) = Al2O3
      V(4)=CATPC(4)+CATPC(28)
C   V(4) = Fe2O3 + V2O3
      V(5)=CATPC(5)+CATPC(7)+CATPC(29)
C   V(5) = FeO + MnO + NiO + CoO
      V(6)=CATPC(8)+CATPC(24)
C   V(6) = MgO + Li2O
      V(7)=CATPC(9)
C   V(7) = CaO + BaO + SrO
      V(8)=CATPC(12)
C   V(8) = Na2O
      V(9)=CATPC(13)+CATPC(30)+CATPC(31)
C   V(9) = K2O + Rb2O + Cs2O
      V(10)=CATPC(14)
C   V(10) = P2O5
      V(11)=CATPC(15)+CATPC(16)
C   V(11) = F- + Cl-
      V(12)=CATPC(17)
C   V(12) = S
      V(13)=CATPC(18)
C   V(13) = CO2
      V(14)=CATPC(19)+CATPC(32)
C   V(14) = ZrO2 + HfO2
      V(15)=CATPC(20)
C   V(15) = SnO2
      V(16)=CATPC(21)
C   V(16) = Cr2O3
      V(17)=CATPC(26)
C   V(17) = H2O+
      V(18)=CATPC(25)
C   V(18) = SO3
      V(19)=CATPC(33)+CATPC(34)+CATPC(35)
C   V(19) = Y2O3 + Ce2O3 + La2O3
      V(20)=CATPC(10)+CATPC(11)
C   V(20) = BaO + SrO
c   *************************************************************
C   NIGGLI MESONORM:   CALCULATION WITH BIOTITE AND/OR HORNBLENDE
C   *************************************************************
C   Normative Cassiterite (Ct).
C   ***************************
      Ct=V(15)
C   Normative Zircon (Z).
C   *********************
      Z=2*V(14)
      V(1)=V(1)-V(14)
C   Normative Monacite (Mon)
C   ************************
      IF (V(19).EQ.0) GOTO 200
      IF (V(19).GE.V(10)) GOTO 190
      Mon=2*V(19)
      V(10)=V(10)-V(19)
      V(19)=0
      GOTO 200
190   Mon=2*V(10)
      V(19)=V(19)-V(10)
      V(10)=0
      GOTO 250
C   Normative Apatite (Ap).
C   ***********************
200   IF (V(10).GT.(0.6*V(7))) GOTO 220
      IF (V(10).LT.(3*V(11))) GOTO 210
      Ap=V(11)+((8./3.)*V(10))
      V(7)=V(7)-((5./3.)*V(10))
      V(10)=0
      V(11)=0
      GOTO 250
210   Ap=3*V(10)
      V(7)=V(7)-((5./3.)*V(10))
      V(11)=V(11)-((1./3.)*V(10))
      V(10)=0
      GOTO 250
220   IF (V(10).LT.(3*V(11))) GOTO 230
      Ap=V(11)+((5./3.)*V(7))
      V(10)=V(10)-((3./5.)*V(7))
      V(11)=0
      V(7)=0
      GOTO 250
230   Ap=1.8*V(7)
      V(11)=V(11)-(0.2*V(7))
      V(10)=V(10)-(0.6*V(7))
      V(7)=0
      WRITE(RESULT,240)V(10)
240   FORMAT(' Insufficient Ca for Apatite, Excess P2O5 = ',F6.2)
      GOTO 280
C   Normative Fluorite (Fr)
C   ***********************
250   IF (V(7).GE.(0.5*V(11))) GOTO 270
      Fr=3*V(7)
      V(11)=V(11)-(2*V(7))
      V(7)=0
      WRITE (RESULT,260) V(11)
260   FORMAT(' Insufficient Ca for Fluorite, Excess F- = ',F6.2)
      GOTO 280
270   Fr=1.5*V(11)
      V(7)=V(7)-(0.5*V(11))
      V(11)=0
C   Normative Baryte (Ba,Sr)SO4 (Bar).
C   **********************************
280   IF (V(18).GT.V(20)) GOTO 290
      Bar=2*V(18)
      V(20)=V(20)-V(18)
      V(18)=0
      GOTO 310
290   Bar=2*V(20)
      V(18)=V(18)-V(20)
      V(20)=0
C   Normative Anhydrite (Anh).
C   **************************
      IF (V(18).LE.0) GOTO 310
      Anh=2*V(18)
      V(7)=V(7)-V(18)
      V(18)=0
C   Normative Calcite (Cc)
C   **********************
310   V(7)=V(7)+V(20)
      IF (V(13).GT.V(7)) GOTO 320
      Cc=2*V(13)
      V(7)=V(7)-V(13)
      V(13)=0
      GOTO 340
320   Cc=2*V(7)
      V(13)=V(13)-V(7)
      V(7)=0
      WRITE(RESULT,330)V(13)
330   FORMAT(' Insufficient Ca for Calcite, Excess CO2 = ',F6.2)
C   Normative Pyrite (Pr)
C   *********************
340   IF(V(5).GE.(0.5*V(12))) GOTO 360
      Pr=3*V(5)
      V(12)=V(12)-(2*V(5))
      V(5)=0
      WRITE(RESULT,350)V(12)
350   FORMAT(' Insufficient FeO for Pyrite, Excess S = ',F6.2)
      GOTO 370
360   Pr=1.5*V(12)
      V(5)=V(5)-(0.5*V(12))
      V(12)=0
C   Normative Chromite (Cm)
C   ***********************
370   V(5)=V(5)+CATPC(6)
      IF (V(5).GE.(0.5*V(16))) GOTO 390
      Cm=3*V(5)
      V(16)=V(16)-(2*V(5))
      V(5)=0
      WRITE(RESULT,380)V(16)
380   FORMAT (' Insufficient FeO for Chromite, Excess Cr = ',F6.2)
      GOTO 400
390   Cm=1.5*V(16)
      V(5)=V(5)-(0.5*V(16))
      V(16)=0
C   Normative Sphene (Tn).
C   **********************
400   IF (V(2).GT.V(7))  GOTO 410
      Tn=3*V(2)
      V(7)=V(7)-V(2)
      V(1)=V(1)-V(2)
      V(2)=0
      GOTO 420
410   Tn=3*V(7)
      V(2)=V(2)-V(7)
      V(1)=V(1)-V(7)
      V(7)=0
C   Normative Ilmenite (Il).
C   ************************
      IF (V(2).GT.V(5)) GOTO 415
      Il=2*V(2)
      V(5)=V(5)-V(2)
      V(2)=0
      GOTO 420
415   Il=2*V(5)
      V(2)=V(2)-V(5)
      V(5)=0
C   Normative Orthoclase (Or)
C   *************************
420   VY=0.04*V(9)
      VX=V(9)+VY
      IF (VX.GT.V(3)) GOTO 430
      Or=5*VX
      V(3)=V(3)-VX
      V(1)=V(1)-(3*VX)
      VX=0
      GOTO 440
430   Or=5*V(3)
      VX=VX-V(3)
      V(1)=V(1)-(3*V(3))
      V(3)=0
C    Normative K-metasilicate (Ks)
C   ******************************
      Ks=1.5*VX
      V(1)=V(1)-(0.5*VX)
      VX=0
C   Normative Albite (Ab)
C   *********************
440   V(8)=V(8)-VY
      IF (V(8).GT.V(3)) GOTO 450
      Ab=5*V(8)
      V(3)=V(3)-V(8)
      V(1)=V(1)-(3*V(8))
      V(8)=0
      GOTO 510
450   Ab=5*V(3)
      V(8)=V(8)-V(3)
      V(1)=V(1)-(3*V(3))
      V(3)=0
C   Normative Riebeckite (Rie).
C   ***************************
      IF (V(4).GT.((2./3.)*V(5))) GOTO 480
      IF (V(8).GT.V(4)) GOTO 470
460   Rie=7.5*V(8)
      V(4)=V(4)-V(8)
      V(5)=V(5)-(1.5*V(8))
      V(1)=V(1)-(4*V(8))
      V(8)=0
      GOTO 510
470   Rie = 7.5*V(4)
      V(8)=V(8)-V(4)
      V(5)=V(5)-(1.5*V(4))
      V(1)=V(1)-(4*V(4))
      V(4)=0
      GOTO 500
480   IF (V(8).GT.((2./3.)*V(5))) GOTO 490
      GOTO 460
490   Rie=5*V(5)
      V(8)=V(8)-((2./3.)*V(5))
      V(4)=V(4)-((2./3.)*V(5))
      V(1)=V(1)-((8./3.)*V(5))
      V(5)=0
C   Normative Na-Metasilicate (Ns).
C   *******************************
500   Ns=1.5*V(8)
      V(1)=V(1)-(0.5*V(8))
      V(8)=0
C   Normative Anorthite (An).
C   *************************
510   IF (V(7).GT.(0.5*V(3))) GOTO 520
      An=5*V(7)
      V(3)=V(3)-(2*V(7))
      V(1)=V(1)-(2*V(7))
      V(7)=0
      GOTO 530
520   An=2.5*V(3)
      V(7)=V(7)-(0.5*V(3))
      V(1)=V(1)-V(3)      
      V(3)=0
      GOTO 540
C   Normative Corundum (C).
C   ***********************
530   C=V(3)
      V(3)=0
C   Normative Magnetite (Mt).
C   *************************
540   IF (V(4).GT.(2*V(5))) GOTO 550
      Mt=1.5*V(4)
      V(5)=V(5)-(0.5*V(4))
      V(4)=0
      GOTO 560
550   Mt=3*V(5)
      V(4)=V(4)-(2*V(5))
      V(5)=0
C   Normative Hematite (Hm).
C   ************************
      Hm=V(4)
      V(4)=0
C   ******************************
560   RATIO=V(6)/(V(5)+0.00000001)
      V(22)=V(6)+V(5)
C   ******************************
C   Normative Biotite (Bi).
C   **********************
      IF (BIOT.NE.'Y'.AND.BIOT.NE.'y') GOTO 600
      IF (V(22).GT.(0.6*Or)) GOTO 570
      Bi=V(2)+((8./3.)*V(22))
      Or=Or-(V(2)+((5./3.)*(V(22)+V(2))))
      V(22)=0
      V(2)=0
      GOTO 580
570   Bi=1.6*Or
      V(22)=V(22)-((0.6*Or)-V(2))
      Or=0
      V(2)=0
C   Normative Muscovite (Mu).
C   *************************
580   IF (MUSCO.NE.'Y'.AND.MUSCO.NE.'y') GOTO 600
      IF (C.GT.(0.4*Or)) GOTO 590
      Mu=3.5*C
      Or=Or-(Mu/1.4)
      C=0
      GOTO 600
590   Mu=1.4*Or
      C=C-(Mu/3.5)
      Or=0
C   Normative Actinolite (Act)
C   **************************
600   IF (V(22).GT.(2.5*V(7))) GOTO 610
      Act=3*V(22)
      V(7)=V(7)-((2./5.)*V(22))
      V(1)=V(1)-((8./5.)*V(22))
      V(22)=0
      GOTO 620
610   Act=7.5*V(7)
      V(22)=V(22)-(2.5*V(7))
      V(1)=V(1)-(4*V(7))
      V(7)=0
C   Normative Hypersthene (Hy).
C   **************************
      Hy=2*V(22)
      V(1)=V(1)-V(22)
      V(22)=0
C   Normative Wollastonite (Wo).
C   ****************************
620   Wo=2*V(7)
      V(1)=V(1)-V(7)
      V(7)=0
C   Normative Quartz (Q).
C   *********************
      IF (V(1).LT.0) GOTO 640
      Q=V(1)
      GOTO 780
640   Q=-V(1)
C   Normative Edenite (Ed).
C   ***********************
      IF (Act.LT.(3*Ab)) GOTO 670
      IF (Ab.LT.(1.25*Q)) GOTO 660
650   Ed=4*Q
      Act=Act-(3.75*Q)
      Ab=Ab-(1.25*Q)
      Q=0
      GOTO 780
660   Ed=3.2*Ab
      Act=Act-(3*Ab)
      Q=Q-(0.8*Ab)
      Ab=0
      GOTO 680
670   IF (Act.GE.(3.75*Q)) GOTO 650
      Ed=(16./15.)*Act
      Ab=Ab-((1./3.)*Act)
      Q=Q-((4./15.)*Act)
      Act=0
C   Normative Olivine (Ol).
C   ***********************
680   IF (Hy.LT.(4*Q)) GOTO 690
      Ol=3*Q
      Hy=Hy-(4*Q)
      Q=0
      GOTO 780
690   Ol=0.75*Hy
      Q=Q-(0.25*Hy)
      Hy=0
C   Normative Spinel (Sp).
C   **********************
      IF (Ol.GT.((4./3.)*C)) GOTO 720
      IF (Ol.LT.(3*Q)) GOTO 710
700   Sp=6*Q
      C=C-(4*Q)
      Ol=Ol-(3*Q)
      Q=0
      GOTO 780
710   Sp=2*Ol
      C=C-((4./3.)*Ol)
      Q=Q-((1./3.)*Ol)
      Ol=0
      GOTO 740
720   IF(C.LT.(4*Q)) GOTO 730
      GOTO 700
730   Sp=1.5*C
      Ol=Ol-(0.75*C)
      Q=Q-(0.25*C)
      C=0
C   Normatine Nepheline (Ne).
C   *************************
740   IF (Ab.LT.((5./2.)*Q)) GOTO 750
      Ne=(3./2.)*Q
      Ab=Ab-((5./2.)*Q)
      Q=0
      GOTO 780
750   Ne=(3./5.)*Ab
      Q=Q-((2./5.)*Ab)
      Ab=0
      WRITE(RESULT,770)Q
770   FORMAT(' Desilification incomplete, SiO2 Deff. = ',F6.2)
C   Normative Hornblende (Ho).
C   ******************
780   Ho=Act+Ed+Rie
C   ******************
      IF (Q.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Q
      MINNAM(NMIN)='Q'
      END IF
      IF (C.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=C
      MINNAM(NMIN)='C'
      END IF
      IF (Or.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Or
      MINNAM(NMIN)='Or'
      END IF
      IF (Ab.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Ab
      MINNAM(NMIN)='Ab'
      END IF
      IF (An.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=An
      MINNAM(NMIN)='An'
      END IF
      IF (Ne.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Ne
      MINNAM(NMIN)='Ne'
      END IF
      IF (Bi.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Bi
      MINNAM(NMIN)='Bi'
      END IF
      IF (Mu.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Mu
      MINNAM(NMIN)='Mu'
      END IF
      IF (Act.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Act
      MINNAM(NMIN)='Act'
      END IF
      IF (Ed.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Ed
      MINNAM(NMIN)='Ed'
      END IF
      IF (Rie.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Rie
      MINNAM(NMIN)='Rie'
      END IF
      IF (Wo.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Wo
      MINNAM(NMIN)='Wo'
      END IF
      IF (Hy.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Hy
      MINNAM(NMIN)='Hy'
      END IF
      IF (Ol.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Ol
      MINNAM(NMIN)='Ol'
      END IF
      IF (Mt.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Mt
      MINNAM(NMIN)='Mt'
      END IF
      IF (Hm.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Hm
      MINNAM(NMIN)='Hm'
      END IF
      IF (Il.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Il
      MINNAM(NMIN)='Il'
      END IF
      IF (Tn.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Tn
      MINNAM(NMIN)='Tn'
      END IF
      IF (Z.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Z
      MINNAM(NMIN)='Z'
      END IF
      IF (Sp.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Sp
      MINNAM(NMIN)='Sp'
      END IF
      IF (Ct.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Ct
      MINNAM(NMIN)='Ct'
      END IF
      IF (Pr.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Pr
      MINNAM(NMIN)='Pr'
      END IF
      IF (Fr.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Fr
      MINNAM(NMIN)='Fr'
      END IF
      IF (Cc.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Cc
      MINNAM(NMIN)='Cc'
      END IF
      IF (Ap.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Ap
      MINNAM(NMIN)='Ap'
      END IF
      IF (Bar.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Bar
      MINNAM(NMIN)='Bar'
      END IF
      IF (Cm.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Cm
      MINNAM(NMIN)='Cm'
      END IF
      IF (Mon.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Mon
      MINNAM(NMIN)='Mon'
      END IF
      IF (Anh.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Anh
      MINNAM(NMIN)='Anh'
      END IF
      IF (Ks.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Ks
      MINNAM(NMIN)='Ks'
      END IF
      IF (Ns.GT.0) THEN
      NMIN=NMIN+1
      MINOUT(NMIN)=Ns
      MINNAM(NMIN)='Ns'
      END IF
C   Presentation of the results
C   ***************************
      WRITE(RESULT,790)
790   FORMAT(/2X,' Q	   C	   Or      Ab	   An      Ne  ')
      WRITE(RESULT,800)Q,C,Or,Ab,An,Ne
800   FORMAT(7F8.3/)
      WRITE(RESULT,810)
810   FORMAT(//,2X,' Bi      Mu      Act     Ed      Rie     Wo	   Hy'
     1)
      WRITE(RESULT,820)Bi,Mu,Act,Ed,Rie,Wo,Hy
820   FORMAT(7F8.3/)
      WRITE(RESULT,830)
830   FORMAT(/,2X,' Ol	   Mt	   Hm	   Il	   Tn	   Sp      Cm')
      WRITE(RESULT,840)Ol,Mt,Hm,Il,Tn,Sp,Cm
840   FORMAT(7F8.3/)
      WRITE(RESULT,850)
850   FORMAT(2X,' Z       Mon     Ct      Pr      Fr      Cc      Ap ')
      WRITE(RESULT,860)Z,Mon,Ct,Pr,Fr,Cc,Ap
860   FORMAT(7F8.3/)
      WRITE(RESULT,870)
870   FORMAT(2X,' Bar     Anh     Ks      Ns ')
      WRITE(RESULT,880)Bar,Anh,Ks,Ns
880   FORMAT(5F8.3/)
C   FINAL SUMMARY
C   *******************
      WRITE(RESULT,890)
890   FORMAT(//,27X,'    S U M M A R Y')
      WRITE(RESULT,900)
900   FORMAT(24X,'****************************')
      WRITE(RESULT,1000)
      TOTAL=0
      TOTAL=(Q+C+Or+Ab+An+Ne+Bi+Mu+Act+Ed+Rie+Wo+Hy+Ol+Mt+Hm+Il+Tn+
     1 Z+Sp+Ct+Pr+Fr+Cc+Ap+Bar+Cm+Mon+Anh+Ks+Ns)
      WRITE(RESULT,910) (MINNAM(I),MINOUT(I), I=1,NMIN),'SUM:',TOTAL
910   FORMAT((' *',5(3X,A4,F7.3),' *'))
      WRITE(RESULT,1001)
1001  FORMAT(' *',70X,' *')
      WRITE(RESULT,1001)
      IF (Ho.GT.0) GOTO 930
      WRITE(RESULT,920)
920   FORMAT(' *',1X,' Hornblende   =   0.0',48X,' *')
      GOTO 980
930   IX=0.4+((100*Act)/Ho)
      IY=0.4+((100*Ed)/Ho)
      IZ=0.4+((100*Rie)/Ho)
      WRITE(RESULT,940)Ho,IX,IY,IZ
940   FORMAT((' *',1X,' Hornblende = ',F6.2,'	Act(',I3,') Ed(',I3,') Rie
     1(',I3,')',23X,' *'))
      PY=Wo+Hy
      IF (PY.GT.0) GOTO 960
      WRITE(RESULT,950)
950   FORMAT(' *',1X,' Pyroxene     =   0.0',48X,' *')
      GOTO 980
960   IX=0.4+((100*Wo)/PY)
      IY=0.4+((100*Hy)/PY)
      WRITE(RESULT,970)PY,IX,IY
970   FORMAT((' *',1X,' Pyroxene   = ',F6.2,'	Wo (',I3,') Hy(',I3,')'
     1,32X,' *'))
980   IX=0.5+(100*RATIO)/(RATIO+1)
      IY=100-IX
      WRITE(RESULT,990)IX,IY
990   FORMAT((' *',1X,' Mg/Fe Ratio in Biotite, Hypersthene, Olivine = '
     1,I3,'/'I3,14X,' *'))
      Plag=Ab+An
      IX=(100*Ab)/(Plag+0.5)
      IY=100-IX
      WRITE(RESULT,1090)Plag,IX,IY
1090  FORMAT((' *',1X,' Plagioclase   = ',F6.2,'      Ab(',I3,') An(',I3
     1,')',25X,' *'))
      WRITE(RESULT,1001)
      TOTAL=Q+Or+Ab+An
      IX=(100*Q)/(TOTAL+0.5)
      IY=(100*Or)/(TOTAL+0.5)
      IZ=100-(IX+IY)
      WRITE(RESULT,1100)TOTAL,IX,IY,IZ
1100  FORMAT((' *',1X,' Q  + Or + Plag = ',F6.2,'   Q (',I3,') Or(',I3,'
     1) Plag(',I3,')',17X,' *'))
      TOTAL=0.0
      TOTAL=Ab+An+Or
      IX=(100*Ab)/(TOTAL+0.5)
      IY=(100*An)/(TOTAL+0.5)
      IZ=100-(IX+IY)
      WRITE(RESULT,1120)TOTAL,IX,IY,IZ
1120  FORMAT((' *',1X,' Ab + An + Or   = ',F6.2,'   Ab(',I3,') An(',I3,'
     1) Or  (',I3,')',17X,' *'))
      TOTAL=0.0
      TOTAL=Q+Ab+Or
      IX=(100*Q)/(TOTAL+0.5)
      IY=(100*Ab)/(TOTAL+0.5)
      IZ=100-(IX+IY)
      WRITE(RESULT,1130)TOTAL,IX,IY,IZ
1130  FORMAT((' *',1X,' Q  + Ab + Or   = ',F6.2,'   Q (',I3,') Ab(',I3,'
     1) Or  (',I3,')',17X,' *'))
      WRITE(RESULT,1001)
C   DIFFERENTIATION INDEX (DI)
C   **************************
      DIF=Q+Or+Ab+Ne+Ks
      WRITE(RESULT,1140)DIF
1140  FORMAT(' *',1X,' Differentiation Index (DI) = ',F6.2,33X,' *')
C   CRYSTALLIZATION INDEX (CI)
C   **************************
      CI=An+RATIO/(RATIO+1)*(Py+Ol+(0.75*Hy)+Sp)
      WRITE(RESULT,1150)CI
1150  FORMAT(' *',1X,' Crystallization Index (CI) = ',F6.2,33X,' *')
C
C   SOLIDIFICATION INDEX (SI)
C   *************************
      SI=100*WTP(8)/(WTP(4)+WTP(5)+WTP(6)+WTP(7)+WTP(8)+WTP(12)+WTP(13))
      WRITE(RESULT,1160)SI
1160  FORMAT(' *',1X,' Solidification Index  (SI) = ',F6.2,33X,' *')
C   ALKALINITY RATIO (AR)
C   *********************
      IF (WTP(1).GT.50) THEN
      IF (WTP(13)/WTP(12).GT.1.AND.WTP(13)/WTP(12).LT.2.5) GOTO 1170
      A=WTP(3)+WTP(9)
      B=WTP(12)+WTP(13)+WTP(24)+WTP(30)+WTP(31)
      AR=(A+B)/(A-B)
1170  B=2*WTP(12)
      AR=(A+B)/(A-B)
      WRITE(RESULT,1180)AR
1180  FORMAT(' *',1X,' Alkalinity Ratio      (AR) = ',F6.2,33X,' *')
      END IF
      WRITE(RESULT,1001)
      WRITE(RESULT,1000)
      END
