*IF DEF,A05_2A,OR,DEF,A05_2C AJX1F405.155
C ******************************COPYRIGHT****************************** GTS2F400.1747
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1748
C GTS2F400.1749
C Use, duplication or disclosure of this code is subject to the GTS2F400.1750
C restrictions as set forth in the contract. GTS2F400.1751
C GTS2F400.1752
C Meteorological Office GTS2F400.1753
C London Road GTS2F400.1754
C BRACKNELL GTS2F400.1755
C Berkshire UK GTS2F400.1756
C RG12 2SZ GTS2F400.1757
C GTS2F400.1758
C If no contract has been raised with this copy of the code, the use, GTS2F400.1759
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1760
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1761
C Modelling at the above address. GTS2F400.1762
C ******************************COPYRIGHT****************************** GTS2F400.1763
C GTS2F400.1764
CLL SUBROUTINE DD_INIT------------------------------------------------ DDINIT2A.3
CLL DDINIT2A.4
CLL PURPOSE : ROUTINE TO INITIALISE THE DOWNDRAUGHT DDINIT2A.5
CLL DDINIT2A.6
CLL SUITABLE FOR SINGLE COLUMN MODEL USE DDINIT2A.7
CLL DDINIT2A.8
CLL CODE WRITTEN FOR CRAY Y-MP BY S.BETT AND D.GREGORY AUTUMN 1991 DDINIT2A.9
CLL DDINIT2A.10
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: DDINIT2A.11
CLL VERSION DATE DDINIT2A.12
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.5
CLL DDINIT2A.13
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 DDINIT2A.14
CLL VERSION NO. 4 DATED 5/2/92 DDINIT2A.15
CLL DDINIT2A.16
CLL LOGICAL COMPONENTS COVERED: DDINIT2A.17
CLL DDINIT2A.18
CLL SYSTEM TASK : P27 DDINIT2A.19
CLL DDINIT2A.20
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 DDINIT2A.21
CLL DDINIT2A.22
CLLEND----------------------------------------------------------------- DDINIT2A.23
C DDINIT2A.24
C*L ARGUMENTS--------------------------------------------------------- DDINIT2A.25
C DDINIT2A.26
SUBROUTINE DD_INIT(NPNTS,TH_UD_K,Q_UD_K,THE_K,QE_K,PK,EXK,THDD_K, 4,2DDINIT2A.27
& QDD_K,DELTD,DELQD,BDD_START,K,BDDI,BDD_ON) DDINIT2A.28
C DDINIT2A.29
IMPLICIT NONE DDINIT2A.30
C DDINIT2A.31
C----------------------------------------------------------------------- DDINIT2A.32
C VECTOR LENGTHS AND LOOP COUNTERS DDINIT2A.33
C----------------------------------------------------------------------- DDINIT2A.34
C DDINIT2A.35
C DDINIT2A.39
INTEGER I ! LOOP COUNTER DDINIT2A.40
C DDINIT2A.41
INTEGER NPNTS ! VECTOR LENGTH DDINIT2A.42
C DDINIT2A.43
INTEGER K ! IN PRESENT MODEL LAYER DDINIT2A.44
C DDINIT2A.45
C----------------------------------------------------------------------- DDINIT2A.46
C VARIABLES WHICH ARE INPUT DDINIT2A.47
C----------------------------------------------------------------------- DDINIT2A.48
C DDINIT2A.49
REAL THE_K(NPNTS) ! IN POTENTIAL TEMPERATURE OF DDINIT2A.50
! ENVIRONMENT IN LAYER K (K) DDINIT2A.51
C DDINIT2A.52
REAL TH_UD_K(NPNTS) ! IN PARCEL POTENTIAL TEMPERATURE OF DDINIT2A.53
! UPDRAUGHT, LAYER K (K) DDINIT2A.54
C DDINIT2A.55
REAL QE_K(NPNTS) ! IN MIXING RATIO OF ENVIRONMENT IN DDINIT2A.56
! LAYER K (KG/KG) DDINIT2A.57
C DDINIT2A.58
REAL Q_UD_K(NPNTS) ! IN PARCEL MIXING RATIO OF UPDRAUGHT, DDINIT2A.59
! LAYER K (KG/KG) DDINIT2A.60
C DDINIT2A.61
REAL EXK(NPNTS) ! IN EXNER RATIO OF LAYER K DDINIT2A.62
C DDINIT2A.63
REAL PK(NPNTS) ! IN PRESSURE OF LAYER K (PA) DDINIT2A.64
C DDINIT2A.65
LOGICAL BDDI(NPNTS) ! IN MASK FOR THOSE POINTS WHERE DDINIT2A.66
! DOWNDRAUGHT MAY INITIATE DDINIT2A.67
C DDINIT2A.68
LOGICAL BDD_ON(NPNTS) ! IN MASK FOR THOSE POINTS WHERE DDINIT2A.69
! DOWNDRAUGHT IS ON DDINIT2A.70
C DDINIT2A.71
C----------------------------------------------------------------------- DDINIT2A.72
C VARIABLES WHICH ARE INPUT AND OUTPUT DDINIT2A.73
C----------------------------------------------------------------------- DDINIT2A.74
C DDINIT2A.75
LOGICAL BDD_START(NPNTS) ! INOUT DDINIT2A.76
! IN MASK FOR THOSE POINT WHERE DDINIT2A.77
! DOWNDRAUGHT MAY START DDINIT2A.78
! OUT MASK FOR THOSE POINTS WHERE DDINIT2A.79
! DDINIT2A.80
C DDINIT2A.81
C----------------------------------------------------------------------- DDINIT2A.82
C VARIABLES WHICH ARE OUTPUT DDINIT2A.83
C----------------------------------------------------------------------- DDINIT2A.84
C DDINIT2A.85
REAL THDD_K(NPNTS) ! OUT DOWNDRAUGHT POTENTIAL TEMPERATURE DDINIT2A.86
! OF LAYER K DDINIT2A.87
C DDINIT2A.88
REAL QDD_K(NPNTS) ! OUT DOWNDRAUGHT MIXING RATIO OF DDINIT2A.89
! LAYER K DDINIT2A.90
C DDINIT2A.91
REAL DELTD(NPNTS) ! OUT COOLING NECESSARY TO ACHIEVE DDINIT2A.92
! SATURATION DDINIT2A.93
C DDINIT2A.94
REAL DELQD(NPNTS) ! OUT MOISTENING NECESSARY TO ACHIEVE DDINIT2A.95
! SATURATION DDINIT2A.96
C DDINIT2A.97
C----------------------------------------------------------------------- DDINIT2A.98
C VARIABLES WHICH ARE DEFINED LOCALLY DDINIT2A.99
C----------------------------------------------------------------------- DDINIT2A.100
C DDINIT2A.101
C DDINIT2A.123
REAL TH_MEAN(NPNTS) ! MEAN POTENTIAL TEMPERATURE USED IN DDINIT2A.124
! CALCULATION OF SATURATED DOWNDRAUGHT DDINIT2A.125
! POTENTIAL TEMPERATURE IN LAYER K DDINIT2A.126
C DDINIT2A.127
REAL Q_MEAN(NPNTS) ! MEAN MIXING RATIO USED IN CALCULATION DDINIT2A.128
! OF SATURATED DOWNDRAUGHT DDINIT2A.129
! MIXING RATIO FOR LAYER K DDINIT2A.130
C DDINIT2A.131
REAL T_MEAN(NPNTS) ! MEAN TEMPERATURE USED IN CALCULATION DDINIT2A.132
! OF SATURATED DOWNDRAUGHT POTENTIAL DDINIT2A.133
! TEMPERATURE OF LAYER K (K) DDINIT2A.134
C DDINIT2A.135
REAL THDDS(NPNTS) ! SATURATED DOWNDRAUGHT POTENTIAL DDINIT2A.136
! TEMPERATURE IN LAYER K (K) DDINIT2A.137
C DDINIT2A.138
REAL QDDS(NPNTS) ! SATURATED DOWNDRAUGHT MIXING RATIO DDINIT2A.139
! IN LAYER K (KG/KG) DDINIT2A.140
C DDINIT2A.141
C DDINIT2A.143
REAL BUOY ! BUOYANCY OF PARCEL IN LAYER K DDINIT2A.144
C DDINIT2A.145
REAL THDD_V ! VIRTUAL POTENTIAL TEMPERATURE OF DDINIT2A.146
! PARCEL IN LAYER K DDINIT2A.147
C DDINIT2A.148
REAL THE_V ! VIRTUAL POTENTIAL TEMPERATURE OF DDINIT2A.149
! ENVIRONMENT IN LAYER K DDINIT2A.150
C DDINIT2A.151
C----------------------------------------------------------------------- DDINIT2A.152
C EXTERNAL ROUTINES CALLED DDINIT2A.153
C----------------------------------------------------------------------- DDINIT2A.154
C DDINIT2A.155
EXTERNAL SATCAL DDINIT2A.156
C DDINIT2A.157
C----------------------------------------------------------------------- DDINIT2A.158
C CALCULATE MEAN TEMPERATURE AND MIXING RATIO DDINIT2A.159
C----------------------------------------------------------------------- DDINIT2A.160
C DDINIT2A.161
DO I=1,NPNTS DDINIT2A.162
TH_MEAN(I) = (THE_K(I)+TH_UD_K(I))*0.5 DDINIT2A.163
Q_MEAN(I) = (QE_K(I)+Q_UD_K(I))*0.5 DDINIT2A.164
T_MEAN(I) = TH_MEAN(I)*EXK(I) DDINIT2A.165
END DO DDINIT2A.166
C DDINIT2A.167
C----------------------------------------------------------------------- DDINIT2A.168
C CALCULATE SATURATED DOWNDRAUGHT POTENTIAL TEMPERATURE FOR LAYER K DDINIT2A.169
C----------------------------------------------------------------------- DDINIT2A.170
C DDINIT2A.171
CALL SATCAL
(NPNTS,T_MEAN,TH_MEAN,PK,QDDS,THDDS,K,EXK,Q_MEAN, DDINIT2A.172
* THE_K) DDINIT2A.173
C DDINIT2A.174
C----------------------------------------------------------------------- DDINIT2A.175
C IS SATURATED PARCEL NEGATIVELY BUOYANT COMPARED TO ENVIRONMENT DDINIT2A.176
C----------------------------------------------------------------------- DDINIT2A.177
C DDINIT2A.178
DO I=1,NPNTS DDINIT2A.179
IF (.NOT. BDD_ON(I) .AND. BDDI(I) .AND. K.GE.4) THEN DDINIT2A.180
THDD_V = THDDS(I)*(1.0+0.61*QDDS(I)) DDINIT2A.181
THE_V = THE_K(I)*(1.0+0.61*QE_K(I)) DDINIT2A.182
BUOY = THDD_V - THE_V DDINIT2A.183
C DDINIT2A.184
IF (BUOY .LT. 0.5 ) THEN DDINIT2A.185
C DDINIT2A.186
C----------------------------------------------------------------------- DDINIT2A.187
C INITIATE DOWNDRAUGHT DDINIT2A.188
C----------------------------------------------------------------------- DDINIT2A.189
C DDINIT2A.190
THDD_K(I) = THDDS(I) DDINIT2A.191
QDD_K(I) = QDDS(I) DDINIT2A.192
BDD_START(I) = .TRUE. DDINIT2A.193
C DDINIT2A.194
C----------------------------------------------------------------------- DDINIT2A.195
C CALCULATE COOLING AND MOISTENING TO ACHIEVE SATURATION DDINIT2A.196
C----------------------------------------------------------------------- DDINIT2A.197
C DDINIT2A.198
DELTD(I) = THDDS(I)-THE_K(I) DDINIT2A.199
DELQD(I) = QDDS(I)-QE_K(I) DDINIT2A.200
END IF DDINIT2A.201
END IF DDINIT2A.202
END DO DDINIT2A.203
C DDINIT2A.204
RETURN DDINIT2A.205
END DDINIT2A.206
C DDINIT2A.207
*ENDIF DDINIT2A.208