C  FORTRAN 77; PROGRAM BOGUE.FOR; Vers:1.0;10/10/92
C  ************************************************
$DEBUG
      INTEGER IN,OUT,REF,RESULT,OXOUT(15),NOXOUT
      REAL Lm,LOI,LSF,INSOL
      PARAMETER (IN=5, OUT=6, REF=9, RESULT=10)
      CHARACTER*1 ANSWER
      CHARACTER*5 OXIDE(15), TITLEX
      CHARACTER*30 NAME
      DIMENSION WTP(15),V(14),H(12),CATPC(15)
C  ***********************************************
C  WTP   - WeighT Percent. OXIDE  - OXIDE analysed
C  CATPC - CATion PerCent.
C  ***********************************************
      DATA OXIDE(1)/'SiO2 '/
      DATA OXIDE(2)/'TiO2 '/
      DATA OXIDE(3)/'Al2O3'/
      DATA OXIDE(4)/'Fe2O3'/
      DATA OXIDE(5)/'Mn2O3'/
      DATA OXIDE(6)/'MgO  '/
      DATA OXIDE(7)/'CaO  '/
      DATA OXIDE(8)/'Na2O '/
      DATA OXIDE(9)/'K2O  '/
      DATA OXIDE(10)/'P2O5 '/
      DATA OXIDE(11)/'CO2  '/
      DATA OXIDE(12)/'SO3  '/
      DATA OXIDE(13)/'LOI  '/
      DATA OXIDE(14)/'FLm  '/
      DATA OXIDE(15)/'Insol'/
C  ************************
      SUM=0.0
      SUM1=0.0
      WRITE(OUT,10)
10    FORMAT(/' Sample 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), Enter free CaO as FLm & Insolu
     &bles as Insol.'/)
      DO 5 IJ=1,NUM
2     READ(IN,60)TITLEX,WTPER
60    FORMAT(A,F8.4)
      DO 3 I=1,15
      NUMCOM=I
      IF(TITLEX.EQ.OXIDE(I)) GOTO 4
3     CONTINUE
      WRITE(OUT,70)TITLEX
70    FORMAT(/' No compound called',A,'in data')
      WRITE(OUT,80)
80    FORMAT(/' Do you want to try again (Y/y)?')
      READ(IN,20) ANSWER
      IF (ANSWER.EQ.'Y'.OR.ANSWER.EQ.'y') GOTO 2
      STOP
4     CONTINUE
      IF (I.LT.14) SUM=SUM+WTPER
      WTP(NUMCOM)=WTPER
5     CONTINUE
      OPEN(UNIT=RESULT, FILE='BOGUE.OUT')
      WRITE(RESULT,90)NAME
90    FORMAT(15X,' S A M P L E: ',A)
      WRITE(RESULT,1000)
1000  FORMAT(1X,73('*'))
      WRITE(RESULT,100)
100   FORMAT(3X,'Oxides',4X,'wt-%',4X,'Oxides',4X,'wt-%',4X,'Oxides',
     &4X,'wt-%',4X,'Oxides',4X,'wt-%')
      NOXOUT=0
      DO 6 I=1,15
      CATPC(I)=WTP(I)
      SUM1=SUM1+CATPC(I)
6     CONTINUE
      DO 7 IJ=1,15
      CATPC(IJ)=100*CATPC(IJ)/SUM1
      IF (WTP(IJ).NE.0) THEN
      NOXOUT=NOXOUT+1
      OXOUT(NOXOUT)=IJ
      ENDIF
7     CONTINUE
      WRITE(RESULT,110)(OXIDE(OXOUT(I)),WTP(OXOUT(I)), I=1,NOXOUT)
110   FORMAT(3X,A,F9.3,4X,A,F9.3,4X,A,F9.3,4X,A,F9.3)
      WRITE(RESULT,120)SUM
120   FORMAT(/,2X,6H Total,F9.3)
C  ********************
      V(1)=CATPC(1)
      H(1)=CATPC(1)
C  V(1) =SiO2
      V(2)=CATPC(2)
C  V(2)=TiO2
      V(3)=CATPC(3)
      H(3)=CATPC(3)
C  V(3)=Al2O3
      V(4)=CATPC(4)+CATPC(5)
      H(4)=CATPC(4)+CATPC(5)
C  V(4)=Fe2O3+Mn2O3
      V(5)=CATPC(6)
      H(5)=CATPC(6)
C  V(5)=MgO
      V(6)=CATPC(7)
      H(6)=CATPC(7)
C  V(6)=CaO
      V(7)=CATPC(8)
C  V(7)=Na2O
      V(8)=CATPC(9)
C  V(8)=K2O
      V(9)=CATPC(10)
C  V(9)=P2O5
      V(10)=CATPC(11)
C  V(10)=CO2
      V(11)=CATPC(12)
      H(11)=CATPC(12)
C  V(11)=SO3
      V(12)=CATPC(13)
      H(12)=CATPC(13)
C  V(12)=LOI
      V(13)=CATPC(14)
C  V(13)= Free CaO
      V(14)=CATPC(15)
C  V(14)=Insolubles not included in the total.
      WRITE(RESULT,1000)
      WRITE(RESULT,1000)
C  ****************************************************************
C  LIME SATURATION FACTOR (LSF)=CaO/(2.8*SiO2+1.2*Al2O3+0.65*Fe2O3)
C  ****************************************************************
      LSF=0.0
      LSF=V(6)/(2.8*V(1)+1.2*V(3)+0.65*V(4))
C  ************************************
C  SILICA RATIO (SR)=SiO2/(AL2O3+Fe2O3)
C  ************************************
      SR=0.0
      SR=V(1)/(V(3)+V(4))
C  ******************************
C  ALUMINA RATIO (AR)=AL2O3/Fe2O3
C  ******************************
      AR=0.0
      AR=V(3)/V(4)
C  *******************************************
C  Anhydrite (CS) CaO.SO3: V(6)=CaO; V(11)=SO3
C  *******************************************
      IF (V(11).LE.0) GOTO 130
      CS=V(11)+(0.7004*V(11))
      V(6)=V(6)-(0.7004*V(11))
      V(11)=0
C  ***********************************************************
C  Ferrite or Calcium Alumino Ferrite (C4AF) 4CaO.Al2O3.Fe2O3:
C  V(6)=CaO; V(3)=Al2O3; V(4)=Fe2O3
C  ***********************************************************
130   IF (V(4).LE.0) GOTO 140
      B=0.6385*V(4)
      C=1.4046*V(4)
      CAF=V(4)+B+C
      V(3)=V(3)-B
      V(6)=V(6)-C
      V(4)=0
C  *****************************
C  Periclase (Per) MgO: V(5)=MgO
C  *****************************
140   IF (V(5).LE.0) GOTO 150
      Per=V(5)
C  ***************************************************
C  Aluminate or Tricalcium Aluminate (C3A) 3CaO.Al2O3:
C  V(6)=CaO; V(3)=Al2O3
C  ***************************************************
150   IF (V(3).LE.0) GOTO 160
      TCA=V(3)+(1.65*V(3))
      V(6)=V(6)-(1.65*V(3))
      V(3)=0
C  ***********************************************
C  Belite or Dicalcium Silicate (C2S) 2CaO.SiO2:
C  V(6)=CaO; V(1)=SiO2; Approximate value for DCS:
C  ***********************************************
160   X=V(1)+V(6)
      DCS=V(1)+(1.866*V(1))
      V(6)=X-DCS
C  *********************************************
C  Alite or Tricalcium Silicate (C3S) 3CaO.SiO2:
C  V(6)=CaO; V(1)=SiO2
C  *********************************************
      TCS=V(6)+(3.0715*V(6))
C  ****************
C  FINAL DCS VALUE
C  ***************
      DCS=X-TCS
C  *********************
      IF (TCS.GE.X) THEN
      TCS=V(1)+(2.8*V(1))
      DCS=0.0
      END IF
C  ***********************
C  Lime (Lm) CaO: V(6)=CaO
C  ***********************
      Lm=X-(TCS+DCS)
C  *************
C  IGNITION LOSS
C  *************
170   LOI=V(12)
      FLm=V(13)
      Insol=V(14)
C  *******************
      WRITE(RESULT,200)
200   FORMAT(/2X,' C3S    C2S    TCA    C4AF   Lm     Per    Anh    Igni
     &tion Loss')
      WRITE(RESULT,210)TCS,DCS,TCA,CAF,Lm,Per,CS,LOI
210   FORMAT(7F7.2,3XF7.2/)
      WRITE(RESULT,220)
220   FORMAT(/2X,' Free CaO   Insolubles')
      WRITE(RESULT,230)FLm,Insol
230   FORMAT(2X,F7.2,5X,F7.2/)
      WRITE(RESULT,1000)
      WRITE(RESULT,1000)
C  **************************************************************
C  Second method from the book Cement Chemistry by H.F.W.  Taylor
C  **************************************************************
C  *******************
      WRITE(RESULT,300)
300   FORMAT(' Bogue numbers after H.F.W. Taylor (1990). Cement & Chemis
     &try. pp.62-63.')
C  *******************
      WRITE(RESULT,1000)
      TCS=0
      DCS=0
      TCA=0
      CAF=0
      CS=0.0
      LOI=0
      CS=H(11)+0.7004*H(11)
      H(6)=H(6)-0.7004*H(11)
      TCS=(4.0714*H(6))-(7.6024*H(1))-(6.7187*H(3))-(1.4297*H(4))
      DCS=(2.8675*H(1))-(0.7544*TCS)
      TCA=(2.6504*H(3))-(0.7544*H(4))
      CAF=(3.0432*H(4))
      LOI=H(12)
      WRITE(RESULT,310)
310   FORMAT(/2X,' C3S    C2S    TCA    C4AF   Anh   Ignition Loss')
      WRITE(RESULT,320)TCS,DCS,TCA,CAF,CS,LOI
320   FORMAT(5F7.2,3X,F7.2)
      WRITE(RESULT,1000)
      WRITE(RESULT,1000)
      WRITE(RESULT,330)LSF
330   FORMAT(1X,' Lime Saturation Factor (LSF) =',F6.2)
      WRITE(RESULT,340)SR
340   FORMAT(1X,' Silica Ratio (SR)            =',F6.2)
      WRITE(RESULT,350)AR
350   FORMAT(1X,' Alumina Ratio (AR)           =',F6.2)
      STOP
      END
