      SUBROUTINE THCAL4 (TSH,TSHB, TG,GT, SH,SHT,SHXKJ, 
     1                   ILEV,LEV, ILG,IS,IF)
C
C     * JAN 05/2003 - M.LAZARE. UNUSED "IRAD" REMOVED FROM CALL.
C     * MAR 22/2001 - M.LAZARE. NEW VERSION FOR GCMIV ONWARD.
C     *                         LIKE THCAL3 EXCEPT TSHB(1)=TSH(1)=TSH(2),
C     *                         I.E. NO EXTRAPOLATION. CONSEQUENTLY,
C     *                         "SIG1" IS NO LONGER NEEDED AND ALL
C     *                         REFERENCES TO THE "LWCONS" COMMON BLOCK
C     *                         IS REMOVED.
C     * MAY 20/97 - M.LAZARE.   PREVIOUS VERSION THCAL3 FOR GCMIII.
C     * SEP 23/88 - M.LAZARE.   PREVIOUS MODEL VERSION THCAL2 FOR GCMII.
C 
C     * SET TEMPERATURE ARRAYS FOR PHYSICS ON THERMODYNAMICS LEVELS 
C     * FOR HYBRID VERSION OF MODEL.
C     * SHB ARE THERMODYNAMICS LAYER INTERFACES,
C     * SH  ARE THERMODYNAMICS MID LAYER POSITIONS. 
C     * LEV = ILEV+1. 
C     * 
C     *        THERMODYNAMICS 
C     *     INTERFACE   MID LAYER  TG(MODEL) TSH(TH)     TSHB(TF) 
C     * 
C     *        SIGMA=0. ////////////////////////////////////////////////
C     *                  MOON LAYER          TSH(1) 
C     * SHT(1)=THERMO.TOP ------------------------------ TSHB(1)
C     *                  SH(1)     TG(1)     TSH(2) 
C     * SHT(2)=SHB(1) ---------------------------------- TSHB(2)
C     *                  SH(2)     TG(2)     TSH(3) 
C     * SHT(3)=SHB(2) ---------------------------------- TSHB(3)
C     *                  SH(3)     TG(3)     TSH(4) 
C     * SHT(4)=SHB(3) ---------------------------------- TSHB(4)
C     *                  SH(4)     TG(4)     TSH(5) 
C     * SHT(5)=SHB(4) ---------------------------------- TSHB(5)
C     *                  SH(5)     TG(5)     TSH(6) 
C     * SHT(6)=SHB(5)=1. /////////////////////////////// TSHB(6)

      IMPLICIT REAL   (A-H,O-Z),
     +INTEGER (I-N)
  
      REAL    TG (ILG,ILEV)
      REAL   TSH (ILG, LEV), TSHB (ILG, LEV), GT   (ILG)
      REAL    SH (ILG,ILEV),  SHT (ILG, LEV), SHXKJ(ILG,ILEV) 
C-----------------------------------------------------------------------
C     * MID LAYER TEMPERATURES, WITH EXTRA ONE AT TOP.
C 
      DO 100 L=1,ILEV 
      DO 100 I=IS,IF
      TSH(I,L+1) = TG(I,L)
  100 CONTINUE
C 
C     * LAYER INTERFACE TEMPERATURES, WITH EXTRA ONE AT TOP.
C     * TEMPERATURE DISCONTINUITY AT THE GROUND BASED ON ADIABATIC
C     * EXTRAPOLATION TO SURFACE UNDER UNSTABLE CONDITIONS ONLY, I.E. 
C     * FOR THESE CASES MOST OF THE SUPERADIABATIC LAPSE RATE IS
C     * CONTAINED VERY CLOSE TO THE SURFACE.
C 
      DO 200 I=IS,IF
  200 TSHB(I,LEV)=MIN( TSH(I,LEV)/SHXKJ(I,ILEV), GT(I) )
C 
      DO 300 L=1,ILEV-1 
      DO 300 I=IS,IF
      TSHB(I,L+1) = (TSH(I,L+1)*LOG(SH (I,L+1)/SHT(I,L+1)) 
     1              +TSH(I,L+2)*LOG(SHT(I,L+1)/SH (I  ,L)))
     2                         /LOG(SH (I,L+1)/SH (I  ,L)) 
  300 CONTINUE
C 
C     * TOP LAYER BASE AND MOON LAYER TEMPERATURE. 
C
      DO 400 I=IS,IF 
         TSHB(I,1)=TSH(I,2)
          TSH(I,1)=TSH(I,2)
  400 CONTINUE 
C 
      RETURN
C-----------------------------------------------------------------------
      END 
