*IF DEF,A18_1A,OR,DEF,A18_2A,OR,DEF,RECON VSB1F304.153
C ******************************COPYRIGHT****************************** GTS2F400.3907
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3908
C GTS2F400.3909
C Use, duplication or disclosure of this code is subject to the GTS2F400.3910
C restrictions as set forth in the contract. GTS2F400.3911
C GTS2F400.3912
C Meteorological Office GTS2F400.3913
C London Road GTS2F400.3914
C BRACKNELL GTS2F400.3915
C Berkshire UK GTS2F400.3916
C RG12 2SZ GTS2F400.3917
C GTS2F400.3918
C If no contract has been raised with this copy of the code, the use, GTS2F400.3919
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3920
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3921
C Modelling at the above address. GTS2F400.3922
C ******************************COPYRIGHT****************************** GTS2F400.3923
C GTS2F400.3924
CLL SUBROUTINE HMRTORH ------------------------------------------------ HMR2RH1A.3
CLL HMR2RH1A.4
CLL Purpose : Convert Humidity Mixing Ratio to Relative Humidity HMR2RH1A.5
CLL and vice versa. Option to re-initialise cloud water HMR2RH1A.6
CLL from rh and temp. HMR2RH1A.7
CLL HMR2RH1A.8
CLL KRMODE = 1 - For HMR to RH HMR2RH1A.9
CLL KRMODE = 2 - For RH to HMR HMR2RH1A.10
CLL HMR2RH1A.12
CLL Model Modification history from model version 3.0: HMR2RH1A.13
CLL version date HMR2RH1A.14
CLL AD100293.11
CLL 3.1 10/02/93 Hardwired calls to TIMER removed AD100293.12
CLL Author: A. Dickinson Reviewer: F. Rawlins AD100293.13
CLL 3.4 07/09/94 Remove cloud water/ice and KRMODE=3 option ABM1F304.223
CLL Remove RHCRIT from arg list & ref to REINITQC ABM1F304.224
CLL Bruce M ABM1F304.225
CLL 3.4 19/09/94 Make available to A18_2A S Bell VSB1F304.154
CLL HMR2RH1A.15
CLL Programming Standard : UM Doc Paper No 4 ; Version 3 ; 7/9/90 HMR2RH1A.16
CLL HMR2RH1A.17
CLL Project Task : P3 HMR2RH1A.18
CLL HMR2RH1A.19
CLLEND------------------------------------------------------------------ HMR2RH1A.20
C*L Arguments HMR2RH1A.21
SUBROUTINE HMRTORH (KRMODE,AK,BK,EXNER, 2,1HMR2RH1A.22
+ PSTAR,THETA,RH, HMR2RH1A.23
+ P_FIELD,P_LEVELS,Q_LEVELS, HMR2RH1A.25
+ AKH,BKH,ICODE,CMESSAGE) HMR2RH1A.26
IMPLICIT NONE HMR2RH1A.27
*CALL ACPARM 
HMR2RH1A.28
*CALL COMACP HMR2RH1A.29
C----------------------------------------------------------------------- HMR2RH1A.30
INTEGER KRMODE HMR2RH1A.31
INTEGER P_FIELD,P_LEVELS,Q_LEVELS HMR2RH1A.32
REAL AK(P_LEVELS) ! IN Hybrid cordinates. A and B values HMR2RH1A.33
REAL BK(P_LEVELS) ! at model full levels. HMR2RH1A.34
REAL AKH(P_LEVELS+1) ! IN Hybrid coordinates. A and B values HMR2RH1A.35
REAL BKH(P_LEVELS+1) ! at model half levels. HMR2RH1A.36
REAL EXNER (P_FIELD,P_LEVELS+1) HMR2RH1A.37
REAL PSTAR (P_FIELD) HMR2RH1A.38
REAL THETA (P_FIELD,P_LEVELS) HMR2RH1A.39
REAL RH (P_FIELD,Q_LEVELS) HMR2RH1A.40
HMR2RH1A.44
INTEGER ICODE HMR2RH1A.45
CHARACTER*256 CMESSAGE HMR2RH1A.46
C======================================================================= HMR2RH1A.47
C UM Constant comdeck HMR2RH1A.48
*CALL C_R_CP HMR2RH1A.49
C----------------------------------------------------------------------- HMR2RH1A.50
C Dynamic allocation HMR2RH1A.51
REAL PRESSURE (P_FIELD) HMR2RH1A.52
REAL TEMP (P_FIELD) HMR2RH1A.53
REAL SMR (P_FIELD) HMR2RH1A.54
C======================================================================= HMR2RH1A.55
C Local variables HMR2RH1A.56
INTEGER JLEV,J HMR2RH1A.57
REAL P_JLEV1,P_JLEV ! Pressure at half levels jlev+1 and jlev HMR2RH1A.58
REAL EXNER_FULL ! Exner Pressure at full model level HMR2RH1A.59
HMR2RH1A.60
C======================================================================= HMR2RH1A.61
EXTERNAL QSAT,TIMER ABM1F304.226
C======================================================================= HMR2RH1A.63
*CALL P_EXNERC HMR2RH1A.64
HMR2RH1A.65
HMR2RH1A.67
DO JLEV=1,Q_LEVELS HMR2RH1A.68
HMR2RH1A.69
C Convert Theta to Temperature HMR2RH1A.70
C ---------------------------- HMR2RH1A.71
DO J=1,P_FIELD HMR2RH1A.72
P_JLEV1 = AKH(JLEV+1) + BKH(JLEV+1)*PSTAR(J) HMR2RH1A.73
P_JLEV = AKH(JLEV) + BKH(JLEV) *PSTAR(J) HMR2RH1A.74
EXNER_FULL = P_EXNER_C HMR2RH1A.75
+ (EXNER(J,JLEV+1),EXNER(J,JLEV),P_JLEV1,P_JLEV,KAPPA) HMR2RH1A.76
TEMP(J) = THETA(J,JLEV) * EXNER_FULL HMR2RH1A.77
ENDDO HMR2RH1A.78
HMR2RH1A.79
C Get Pressure HMR2RH1A.80
C ------------ HMR2RH1A.81
DO J=1,P_FIELD HMR2RH1A.82
PRESSURE(J) = BK(JLEV)*PSTAR(J) HMR2RH1A.83
PRESSURE(J) = AK(JLEV)+PRESSURE(J) HMR2RH1A.84
ENDDO HMR2RH1A.85
HMR2RH1A.86
C Obtain Saturated Mixing Ratio HMR2RH1A.87
C ----------------------------- HMR2RH1A.88
CALL QSAT (SMR,TEMP,PRESSURE,P_FIELD) HMR2RH1A.90
HMR2RH1A.92
IF (KRMODE.EQ.1) THEN HMR2RH1A.93
HMR2RH1A.94
C Convert Mixing Ratio to Relative Humidity HMR2RH1A.95
C ----------------------------------------- HMR2RH1A.96
DO J=1,P_FIELD HMR2RH1A.97
RH(J,JLEV) = RH(J,JLEV)/SMR(J) HMR2RH1A.98
RH(J,JLEV) = RH(J,JLEV)*100.0 HMR2RH1A.99
ENDDO HMR2RH1A.100
HMR2RH1A.101
ELSEIF (KRMODE.EQ.2) THEN ABM1F304.227
HMR2RH1A.113
C Convert Relative Humidity to Mixing Ratio HMR2RH1A.114
C ----------------------------------------- HMR2RH1A.115
DO J=1,P_FIELD HMR2RH1A.116
RH(J,JLEV) = RH(J,JLEV)*SMR(J) HMR2RH1A.117
RH(J,JLEV) = RH(J,JLEV)*0.01 HMR2RH1A.118
ENDDO HMR2RH1A.119
HMR2RH1A.120
HMR2RH1A.121
ENDIF HMR2RH1A.122
HMR2RH1A.123
ENDDO HMR2RH1A.124
HMR2RH1A.125
RETURN HMR2RH1A.127
END HMR2RH1A.128
*ENDIF HMR2RH1A.129