
      SUBROUTINE INTRP2D (TEMPC, TWARN, MAXT, LGKDAT, LOGK)
*======================================================================|
*
*  Interpolates log K(s) at L-V saturation for non-Supcrt L-V data at
*  25, 50, 100, 150, 200, 250, 300, 350
*
* ---------------------------------------------------------------------|

      IMPLICIT NONE

      LOGICAL    TWARN

      INTEGER    I, IT, J, MAXTIX, IOUT1

      REAL*8     TEMPC, LGKDAT(8), TDATA(8), LOGK, MAXT, SUM

      DATA TDATA
     + /25.D0, 50.D0, 100.D0, 150.D0, 200.D0, 250.D0, 300.D0, 350.D0/
*======================================================================|

      TWARN = .FALSE.

**Max TEMPC value and array index for that value (TDATA(8) = 350 currently)
      IOUT1 = 11
      MAXTIX = 8
      MAXT = 350.D0
      LOGK = 0.D0
      IT   = 0

**Find highest TEMPC for which data exist, and array index for that TEMPC
**   log K = 99999.999 where data do not exist.
      DO 100, I = 8, 2, -1
         IF (LGKDAT(I).EQ.99999.999D0) THEN
            MAXT   = TDATA(I - 1)
            MAXTIX = I - 1
         ENDIF
100   CONTINUE

**Flag if Temperaute is outside the range for which log Ks exist in soltherm.
      IF (TEMPC.GT.TDATA(MAXTIX).OR.TEMPC.LT.TDATA(1)) TWARN = .TRUE.

**If logk only at 25C, set logK = LGKDAT(1)
      IF (MAXTIX.EQ.1) THEN
         IF (TEMPC.LE.35.D0.AND.TEMPC.GE.10.D0) THEN
            LOGK = LGKDAT(1)
         ELSE
            LOGK = 99999.999D0
         ENDIF

**Else if logk only at 25 and 50C, inter/extrapolate w/ LGKDAT(1) and LGKDAT(2)
      ELSE IF (MAXTIX.EQ.2) THEN
         IF (TEMPC.GE.0.01D0.AND.TEMPC.LE.75.D0) THEN
            LOGK = LGKDAT(1) + (TEMPC - 25.D0)*
     +             (LGKDAT(2)-LGKDAT(1))/(50.d0-25.D0)
         ELSE
            LOGK = 99999.999D0
         ENDIF
      ELSE

**Compute desired log K value for the given TEMPC-value (T).......
** The following should work wherever a mineral has data to 100C or above.
** Find where the desired TEMPC value lies in the TEMPC data array.
         DO 150, I = 1,7
            IF (TEMPC.GT.TDATA(I).AND.TEMPC.LE.TDATA(I+1)) IT = I
150      CONTINUE
         IF (TEMPC.GT.TDATA(8)) IT = 7

**If TEMPC .gt. the first TEMPC-array value that is 99999.999 or
** .gt. 400C, set logK to 99999.999. Max extrapolation is 50C.
*         IF (IT.GE.(MAXTIX+1).OR.TEMPC.GT.400.D0) THEN
         IF (TEMPC.GT.TDATA(MAXTIX)+50.D0.OR.TEMPC.GT.400.D0) THEN
            LOGK = 99999.999D0

         ELSE IF (IT.LT.2) THEN
*** If TEMPC .LT. the second TDATA value, use the 3 smallest TDATA values
            DO 300, I = 1, 3
               SUM = LGKDAT(I)
               DO 200, J = 1,3
                  IF (I.NE.J)
     +               SUM = SUM*(TEMPC-TDATA(J))/(TDATA(I)-TDATA(J))
200            CONTINUE
               LOGK = LOGK + SUM
300         CONTINUE

         ELSE IF (IT.GT.MAXTIX-1) THEN
**** If TEMPC .GT. next to last TDATA value, use 3 largest TDATA values
            DO 500, I = MAXTIX-2, MAXTIX
               SUM = LGKDAT(I)
               DO 400, J = MAXTIX-2, MAXTIX
                  IF (I.NE.J)
     +               SUM = SUM*(TEMPC-TDATA(J))/(TDATA(I)-TDATA(J))
400            CONTINUE
               LOGK = LOGK + SUM
500         CONTINUE

         ELSE
**** Else use TDATA values two below, one above TEMPC
            DO 700, I = IT-1, IT+1
               SUM = LGKDAT(I)
               DO 600, J = IT-1, IT+1
                  IF (I.NE.J)
     +               SUM = SUM*(TEMPC -TDATA(J))/(TDATA(I)-TDATA(J))
600            CONTINUE
               LOGK = LOGK + SUM
700         CONTINUE

         ENDIF
      ENDIF
      RETURN
      END


