*IF DEF,SCMA                                                               S_THTCAL.2      
C *****************************COPYRIGHT******************************     S_THTCAL.3      
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved.    S_THTCAL.4      
C                                                                          S_THTCAL.5      
C Use, duplication or disclosure of this code is subject to the            S_THTCAL.6      
C restrictions as set forth in the contract.                               S_THTCAL.7      
C                                                                          S_THTCAL.8      
C                Meteorological Office                                     S_THTCAL.9      
C                London Road                                               S_THTCAL.10     
C                BRACKNELL                                                 S_THTCAL.11     
C                Berkshire UK                                              S_THTCAL.12     
C                RG12 2SZ                                                  S_THTCAL.13     
C                                                                          S_THTCAL.14     
C If no contract has been raised with this copy of the code, the use,      S_THTCAL.15     
C duplication or disclosure of it is strictly prohibited.  Permission      S_THTCAL.16     
C to do so must first be obtained in writing from the Head of Numerical    S_THTCAL.17     
C Modelling at the above address.                                          S_THTCAL.18     
C ******************************COPYRIGHT******************************    S_THTCAL.19     
C                                                                          S_THTCAL.20     

      Subroutine THETA_CALC(theta,t,exner,pstar,akh,bkh,nlevs,points)       8S_THTCAL.21     
C                                                                          S_THTCAL.22     
C     This subroutine converts temperature t to potential temperature      S_THTCAL.23     
C      theta                                                               S_THTCAL.24     
C     Modification History:                                                S_THTCAL.25     
C Version  Date                                                            S_THTCAL.26     
C  4.5     07/98     SCM integrated as a standard UM configuration         S_THTCAL.27     
C                    JC Thil.                                              S_THTCAL.28     
C                                                                          S_THTCAL.29     
      Implicit none                                                        S_THTCAL.30     
C                                                                          S_THTCAL.31     
*CALL C_R_CP                                                               S_THTCAL.32     
      Integer nlevs,points,I,k                                             S_THTCAL.33     
      Real theta(points,nlevs),                                            S_THTCAL.34     
     &  T(points,nlevs),                                                   S_THTCAL.35     
     &  exner(nlevs+1)                                                     S_THTCAL.36     
      Real pu, pl                                                          S_THTCAL.37     
      Real pstar(points)                                                   S_THTCAL.38     
      Real akh(nlevs+1),bkh(nlevs+1)                                       S_THTCAL.39     
*CALL P_EXNERC                                                             S_THTCAL.40     
      Do k = 1, points                                                     S_THTCAL.41     
        Do i = 1, nlevs                                                    S_THTCAL.42     
          pu = pstar(k) * bkh(i+1) + akh(i+1)                              S_THTCAL.43     
          pl = pstar(k) * bkh(i) + akh(i)                                  S_THTCAL.44     
          theta(k,i) = t(k,i)                                              S_THTCAL.45     
     &      /  p_exner_c(exner(i+1),exner(i),pu,pl,kappa)                  S_THTCAL.46     
        enddo                                                              S_THTCAL.47     
      enddo                                                                S_THTCAL.48     
c                                                                          S_THTCAL.49     
      Return                                                               S_THTCAL.50     
      End                                                                  S_THTCAL.51     
C                                                                          S_THTCAL.52     

      Subroutine T_CALC(theta,t,exner,pstar,akh,bkh,nlevs,points)           4S_THTCAL.53     
C                                                                          S_THTCAL.54     
C     This subroutine converts potential temperature t to temperature      S_THTCAL.55     
C      theta                                                               S_THTCAL.56     
C     Modification History:                                                S_THTCAL.57     
C Version  Date                                                            S_THTCAL.58     
C  4.5     07/98     SCM integrated as a standard UM configuration         S_THTCAL.59     
C                    JC Thil.                                              S_THTCAL.60     
C                                                                          S_THTCAL.61     
      Implicit none                                                        S_THTCAL.62     
*CALL C_R_CP                                                               S_THTCAL.63     
                                                                           S_THTCAL.64     
C                                                                          S_THTCAL.65     
      Integer                                                              S_THTCAL.66     
     &  nlevs,points,i,k                                                   S_THTCAL.67     
      Real                                                                 S_THTCAL.68     
     &  theta(points,nlevs),                                               S_THTCAL.69     
     &  t(points,nlevs),                                                   S_THTCAL.70     
     &  exner(points,nlevs+1)                                              S_THTCAL.71     
      Real pu,pl                                                           S_THTCAL.72     
      Real pstar(points)                                                   S_THTCAL.73     
      Real akh(nlevs+1), bkh(nlevs+1)                                      S_THTCAL.74     
*CALL P_EXNERC                                                             S_THTCAL.75     
C                                                                          S_THTCAL.76     
      Do k = 1, points                                                     S_THTCAL.77     
        Do i = 1, nlevs                                                    S_THTCAL.78     
          pu = pstar(k)*bkh(i+1)+akh(i+1)                                  S_THTCAL.79     
          pl = pstar(k)*bkh(i)+akh(i)                                      S_THTCAL.80     
          t(k,i) = theta(k,i)                                              S_THTCAL.81     
     &      * p_exner_c(exner(k,i+1),exner(k,i),pu,pl,kappa)               S_THTCAL.82     
        enddo                                                              S_THTCAL.83     
      enddo                                                                S_THTCAL.84     
C                                                                          S_THTCAL.85     
      Return                                                               S_THTCAL.86     
      End                                                                  S_THTCAL.87     
*ENDIF                                                                     S_THTCAL.88     
                                                                           S_THTCAL.89