SUBROUTINE THLQT2THQ(P_FIELD,Q_LEVELS, 1,1GPB3F403.34
& PSTAR,P_EXNER, GPB3F403.35
& AKH,BKH,AK,BK,RHCRIT, GPB3F403.36
& THETA,Q,QCF,QCL,RHCPT, ASK1F405.93
& ICODE) GPB3F403.38
THL2TH1.13
IMPLICIT NONE THL2TH1.14
! THL2TH1.15
! Description: THL2TH1.16
! Convert thetal,qt to theta,q,cl,cf,cloud amount. THL2TH1.17
! THL2TH1.18
! Method: THL2TH1.19
! Called in ATM_STEP to split conserved variables for 2nd and THL2TH1.20
! subsequent loops over dynamics if using long physics timestep THL2TH1.21
! option. Uses potl.temp to & from temp conversion and routine LS_CLD THL2TH1.22
! to recover cloud water, ice & amount from conserved variables. THL2TH1.23
! THL2TH1.24
! Current Code Owner: R.T.H.Barnes (FR) THL2TH1.25
! THL2TH1.26
! History: THL2TH1.27
! Version Date Comment THL2TH1.28
! ------- ---- ------- THL2TH1.29
! 4.0 31/08/95 New routine. R.T.H.Barnes. THL2TH1.30
! 4.3 3/6/97 Interface and variable names changed to allow calling GPB3F403.32
! from atmdyn. P.Burton GPB3F403.33
! 4.5 13/05/98 Change to subroutine statement: new variable passed ASK1F405.91
! in, and altered call to GLUE_CLD. S. Cusack ASK1F405.92
! THL2TH1.31
! Code Description: THL2TH1.32
! Language: FORTRAN 77 + CRAY extensions THL2TH1.33
! This code is written to UMDP3 v6 programming standards. THL2TH1.34
! THL2TH1.35
! Subroutine arguments GPB3F403.39
INTEGER GPB3F403.40
& P_FIELD ! IN : size of horizonal field GPB3F403.41
&, Q_LEVELS ! IN : number of moist levels GPB3F403.42
&, ICODE ! OUT: return code GPB3F403.43
GPB3F403.44
REAL GPB3F403.45
& PSTAR(P_FIELD) ! IN GPB3F403.46
&, P_EXNER(P_FIELD,Q_LEVELS+1) ! IN GPB3F403.47
&, AKH(Q_LEVELS+1) ! IN GPB3F403.48
&, BKH(Q_LEVELS+1) ! IN GPB3F403.49
&, AK(Q_LEVELS) ! IN GPB3F403.50
&, BK(Q_LEVELS) ! IN GPB3F403.51
&, RHCRIT(Q_LEVELS+1) ! IN GPB3F403.52
&, RHCPT(P_FIELD,Q_LEVELS) ! IN ASK1F405.94
&, THETA(P_FIELD,Q_LEVELS) ! IN/OUT GPB3F403.53
&, Q(P_FIELD,Q_LEVELS) ! IN/OUT GPB3F403.54
&, QCF(P_FIELD,Q_LEVELS) ! IN/OUT GPB3F403.55
&, QCL(P_FIELD,Q_LEVELS) ! IN/OUT GPB3F403.56
GPB3F403.57
GPB3F403.58
GPB3F403.59
! Constants GPB3F403.60
*CALL CPHYSCON 
GPB3F403.61
GPB3F403.62
THL2TH1.70
! Local parameters: THL2TH1.71
! Local scalars: THL2TH1.72
INTEGER I,K ! Loop counters over P_FIELD,Q_LEVELS THL2TH1.73
REAL PL,PU ! Lower and upper pressure values THL2TH1.74
THL2TH1.75
! Local dynamic arrays: THL2TH1.76
REAL CF(P_FIELD,Q_LEVELS) ! cloud fraction from LS_CLD GPB3F403.63
REAL P_X_C(P_FIELD,Q_LEVELS) ! save P_EXNER_C for speed GPB3F403.64
REAL LS_GRID_QC(P_FIELD,Q_LEVELS) ! Qc from LS_CLD GPB3F403.65
REAL LS_BS(P_FIELD,Q_LEVELS) ! bs from LS_CLD GPB3F403.66
THL2TH1.81
! Function & Subroutine calls: THL2TH1.82
External GLUE_CLD GPB3F403.67
*CALL P_EXNERC THL2TH1.84
THL2TH1.85
!- End of header THL2TH1.86
THL2TH1.87
! 1. Convert thetal and qt to theta and q THL2TH1.94
THL2TH1.95
! 1.1 Convert thetal to temperaturel THL2TH1.96
DO K = 1,Q_LEVELS THL2TH1.97
DO I = 1,P_FIELD THL2TH1.98
PU=PSTAR(I)*BKH(K+1)+AKH(K+1) GPB3F403.68
PL=PSTAR(I)*BKH(K)+AKH(K) GPB3F403.69
P_X_C(I,K) = GPB3F403.70
& P_EXNER_C(P_EXNER(I,K+1),P_EXNER(I,K),PU,PL,KAPPA) GPB3F403.71
GPB3F403.72
THETA(I,K)=THETA(I,K)*P_X_C(I,K) GPB3F403.73
END DO ! I THL2TH1.105
END DO ! K THL2TH1.106
THL2TH1.107
! 1.2 Call LS_CLD to convert to temperature, q and cloud variables THL2TH1.108
CALL GLUE_CLD(AK,BK,PSTAR,RHCRIT,Q_LEVELS,RHCPT,P_FIELD,P_FIELD, ASK1F405.95
& THETA,CF,Q,QCF,QCL,LS_GRID_QC,LS_BS,ICODE) GPB3F403.75
THL2TH1.112
! 1.3 Convert temperature back to theta THL2TH1.113
DO K = 1,Q_LEVELS THL2TH1.114
DO I = 1,P_FIELD THL2TH1.115
THETA(I,K)=THETA(I,K)/P_X_C(I,K) GPB3F403.76
END DO ! I THL2TH1.117
END DO ! K THL2TH1.118
THL2TH1.119
RETURN THL2TH1.122
END THL2TH1.123
THL2TH1.124
*ENDIF THL2TH1.125