*IF DEF,A05_2A,OR,DEF,A05_2C,OR,DEF,A05_3B AJX1F405.129
C ******************************COPYRIGHT****************************** GTS2F400.2953
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.2954
C GTS2F400.2955
C Use, duplication or disclosure of this code is subject to the GTS2F400.2956
C restrictions as set forth in the contract. GTS2F400.2957
C GTS2F400.2958
C Meteorological Office GTS2F400.2959
C London Road GTS2F400.2960
C BRACKNELL GTS2F400.2961
C Berkshire UK GTS2F400.2962
C RG12 2SZ GTS2F400.2963
C GTS2F400.2964
C If no contract has been raised with this copy of the code, the use, GTS2F400.2965
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.2966
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.2967
C Modelling at the above address. GTS2F400.2968
C ******************************COPYRIGHT****************************** GTS2F400.2969
C GTS2F400.2970
CLL SUBROUTINE FLAG_WET----------------------------------------------- FLAGW1A.3
CLL FLAGW1A.4
CLL PURPOSE : CALCULATES A MASK FOR WHEN CONDENSATION IS LIQUID FLAGW1A.5
CLL FLAGW1A.6
CLL IF 0.5 * (TK + TK+1) > TICE THEN ANY CONDENSATION FLAGW1A.7
CLL IN LAYER K+1 IS LIQUID FLAGW1A.8
CLL FLAGW1A.9
CLL IF 0.5 * (TK + TK+1) < TICE THEN ANY CONDENSATION FLAGW1A.10
CLL IN LAYER K+1 IS ICE FLAGW1A.11
CLL FLAGW1A.12
CLL SUITABLE FOR SINGLE COLUMN MODEL USE FLAGW1A.13
CLL FLAGW1A.14
CLL CODE REWORKED FOR CRAY Y-MP BY D.GREGORY AUTUMN/WINTER 1989/90 FLAGW1A.15
CLL FLAGW1A.16
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: FLAGW1A.17
CLL VERSION DATE FLAGW1A.18
CLL FLAGW1A.19
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 FLAGW1A.20
CLL VERSION NO. 1 FLAGW1A.21
CLL FLAGW1A.22
CLL SYSTEM TASK : P27 FLAGW1A.23
CLL FLAGW1A.24
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 FLAGW1A.25
CLL SECTION (2B) FLAGW1A.26
CLL FLAGW1A.27
CLLEND----------------------------------------------------------------- FLAGW1A.28
C FLAGW1A.29
C*L ARGUMENTS--------------------------------------------------------- FLAGW1A.30
C FLAGW1A.31
SUBROUTINE FLAG_WET (BWATER,TH,EXNER,PSTAR,AKH,BKH, 4FLAGW1A.32
& NP_FIELD,NPNTS,NLEV) FLAGW1A.33
C FLAGW1A.34
C----------------------------------------------------------------------- FLAGW1A.35
C RETURNS 'BWATER' - A BIT VECTOR OF POINTS WHERE CONDENSATE IS WATER FLAGW1A.36
C RATHER THAN ICE. FLAGW1A.37
C----------------------------------------------- AUTHOR: M FISHER 1987 - FLAGW1A.38
C FLAGW1A.39
IMPLICIT NONE FLAGW1A.40
C FLAGW1A.41
C---------------------------------------------------------------------- FLAGW1A.42
C MODEL CONSTANTS FLAGW1A.43
C---------------------------------------------------------------------- FLAGW1A.44
C FLAGW1A.45
*CALL TICE 
FLAGW1A.46
*CALL C_R_CP FLAGW1A.47
C FLAGW1A.48
C---------------------------------------------------------------------- FLAGW1A.49
C VECTOR LENGTHS AND LOOP COUNTERS FLAGW1A.50
C---------------------------------------------------------------------- FLAGW1A.51
C FLAGW1A.52
INTEGER NP_FIELD ! IN FULL VECTOR LENGTH FLAGW1A.53
C FLAGW1A.54
INTEGER NPNTS ! IN VECTOR LENGTH FLAGW1A.55
C FLAGW1A.56
INTEGER NLEV ! IN NUMBER OF MODEL LAYERS FLAGW1A.57
C FLAGW1A.58
INTEGER I,K ! LOOP COUNTERS FLAGW1A.59
C FLAGW1A.60
C FLAGW1A.61
C---------------------------------------------------------------------- FLAGW1A.62
C VARIABLES WHICH ARE INPUT FLAGW1A.63
C---------------------------------------------------------------------- FLAGW1A.64
C FLAGW1A.65
REAL TH(NP_FIELD,NLEV) ! IN POTENTIAL TEMPERATURE (K) FLAGW1A.66
C FLAGW1A.67
REAL EXNER(NP_FIELD,NLEV+1) ! IN EXNER RATIO AT LAYER FLAGW1A.68
! BOUNDARIES (STARTING WITH THE FLAGW1A.69
! SURFACE) FLAGW1A.70
C FLAGW1A.71
REAL PSTAR(NPNTS) ! IN Surface pressure FLAGW1A.72
C FLAGW1A.73
REAL AKH(NLEV+1) ! IN Hybrid coordinate A at FLAGW1A.74
! layer boundary FLAGW1A.75
REAL BKH(NLEV+1) ! IN Hybrid coordinate B at FLAGW1A.76
! layer boundary FLAGW1A.77
C FLAGW1A.78
C---------------------------------------------------------------------- FLAGW1A.79
C VARIABLES WHICH ARE OUTPUT FLAGW1A.80
C---------------------------------------------------------------------- FLAGW1A.81
C FLAGW1A.82
LOGICAL BWATER(NPNTS,2:NLEV) ! OUT MASK FOR THOSE POINTS AT FLAGW1A.83
! WHICH CONDENSATE IS LIQUID FLAGW1A.84
C FLAGW1A.85
C FLAGW1A.86
C---------------------------------------------------------------------- FLAGW1A.87
C VARIABLES WHICH ARE DEFINED LOCALLY FLAGW1A.88
C---------------------------------------------------------------------- FLAGW1A.89
C FLAGW1A.90
REAL EXK ! EXNER RATIO FOR LEVEL K FLAGW1A.91
REAL EXKP1 ! EXNER RATIO FOR LEVEL K+1 FLAGW1A.92
C FLAGW1A.93
FLAGW1A.94
REAL FLAGW1A.95
& PU,PL,PU2 FLAGW1A.96
*CALL P_EXNERC FLAGW1A.97
FLAGW1A.98
C*--------------------------------------------------------------------- FLAGW1A.99
CL FLAGW1A.100
CL--------------------------------------------------------------------- FLAGW1A.101
CL NO SIGNIFICANT STRUCTURE FLAGW1A.102
CL--------------------------------------------------------------------- FLAGW1A.103
CL FLAGW1A.104
DO 10 K=1,NLEV-1 FLAGW1A.105
DO 10 I=1,NPNTS FLAGW1A.106
C FLAGW1A.107
PU2=PSTAR(I)*BKH(K+2) + AKH(K+2) FLAGW1A.108
PU=PSTAR(I)*BKH(K+1) + AKH(K+1) FLAGW1A.109
PL=PSTAR(I)*BKH(K) + AKH(K) FLAGW1A.110
EXK = P_EXNER_C(EXNER(I,K+1),EXNER(I,K),PU,PL,KAPPA) FLAGW1A.111
EXKP1 = P_EXNER_C(EXNER(I,K+2),EXNER(I,K+1),PU2,PU,KAPPA) FLAGW1A.112
C FLAGW1A.113
BWATER(I,K+1) = 0.5*(TH(I,K)*EXK + TH(I,K+1)*EXKP1) .GT. TICE FLAGW1A.114
10 CONTINUE FLAGW1A.115
C FLAGW1A.116
RETURN FLAGW1A.117
END FLAGW1A.118
*ENDIF FLAGW1A.119