*IF DEF,A05_3B,OR,DEF,A05_3C,OR,DEF,RECON AJX1F405.161
C *****************************COPYRIGHT****************************** CAL3DCCA.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. CAL3DCCA.4
C CAL3DCCA.5
C Use, duplication or disclosure of this code is subject to the CAL3DCCA.6
C restrictions as set forth in the contract. CAL3DCCA.7
C CAL3DCCA.8
C Meteorological Office CAL3DCCA.9
C London Road CAL3DCCA.10
C BRACKNELL CAL3DCCA.11
C Berkshire UK CAL3DCCA.12
C RG12 2SZ CAL3DCCA.13
C CAL3DCCA.14
C If no contract has been raised with this copy of the code, the use, CAL3DCCA.15
C duplication or disclosure of it is strictly prohibited. Permission CAL3DCCA.16
C to do so must first be obtained in writing from the Head of Numerical CAL3DCCA.17
C Modelling at the above address. CAL3DCCA.18
C ******************************COPYRIGHT****************************** CAL3DCCA.19
! Subroutine CALC_3D_CCA: Calculates a conv. cld amt on model levels. CAL3DCCA.20
! CAL3DCCA.21
! Subroutine Interface: CAL3DCCA.22
SUBROUTINE CALC_3D_CCA(NP_FIELD,NPNTS,NLEV,NBL 3CAL3DCCA.23
& ,ANVIL_FACTOR,TOWER_FACTOR CAL3DCCA.24
& ,AKM12,BKM12,CLOUD_BASE,CLOUD_TOP CAL3DCCA.25
& ,FREEZE_LEV,PSTAR,CCA_2D,CCA_3D,L_CLOUD_DEEP) AJX3F405.153
! CAL3DCCA.27
IMPLICIT NONE CAL3DCCA.28
! CAL3DCCA.29
! Description: Calculates a 3D convective cloud amount (i.e. on model CAL3DCCA.30
! levels) from the 2D convective cloud amount array CAL3DCCA.31
! according to parameters specified in the umui and the CAL3DCCA.32
! position of cloud base, cloud top and freezing level. CAL3DCCA.33
! CAL3DCCA.34
! Method: The 2D convective cloud amount is expanded into the vertical CAL3DCCA.35
! by applying it between the cloud base and top with the CAL3DCCA.36
! additional constraints that CAL3DCCA.37
! (i) If the cloud base is in the boundary layer, CAL3DCCA.38
! (ii) cloud top is above the freezing level and CAL3DCCA.39
! (iii) the cloud is more than 500mb deep CAL3DCCA.40
! then the cloud below the freezing level will be multiplied CAL3DCCA.41
! by TOWER_FACTOR, and the cloud above the freezing level CAL3DCCA.42
! will be linearly (with model level) increased to cloud top CAL3DCCA.43
! where it will be equal to the 2D fraction * ANVIL_FACTOR. CAL3DCCA.44
! CAL3DCCA.45
! Current Code Owner: Julie M. Gregory CAL3DCCA.46
! CAL3DCCA.47
! History: CAL3DCCA.48
! Version Date Comment CAL3DCCA.49
! ------- ---- ------- CAL3DCCA.50
! 4.4 18/9/97 Original code. J.Gregory. CAL3DCCA.51
! CAL3DCCA.52
! Code Description: CAL3DCCA.53
! Language: FORTRAN 77 + common extensions. CAL3DCCA.54
! This code is written to UMDP3 v6 programming standards. CAL3DCCA.55
! CAL3DCCA.56
! System component covered: <appropriate code> CAL3DCCA.57
! System Task: <appropriate code> CAL3DCCA.58
! CAL3DCCA.59
! Global variables (*CALLed COMDECKs etc...): CAL3DCCA.60
!------------------------------------------------------------------ CAL3DCCA.61
! Scalar arguments with intent(in): CAL3DCCA.62
!------------------------------------------------------------------ CAL3DCCA.63
INTEGER NPNTS ! IN Number of points CAL3DCCA.64
& ,NP_FIELD ! IN Full size of data CAL3DCCA.65
& ,NLEV ! IN Number of levels CAL3DCCA.66
& ,NBL ! IN Number of Boundary layer levels CAL3DCCA.67
REAL ANVIL_FACTOR ! IN Needed in calculation of vertical CAL3DCCA.68
& ,TOWER_FACTOR ! IN cloud amount distribution CAL3DCCA.69
LOGICAL L_CLOUD_DEEP ! IN Apply depth criterion if true AJX3F405.154
!------------------------------------------------------------------ CAL3DCCA.70
! Array arguments with intent(in): CAL3DCCA.71
!------------------------------------------------------------------ CAL3DCCA.72
INTEGER CLOUD_TOP(NP_FIELD) ! IN Convective cloud top level CAL3DCCA.73
& ,CLOUD_BASE(NP_FIELD)! IN Convective cloud base level CAL3DCCA.74
& ,FREEZE_LEV(NPNTS) ! IN Freezing level CAL3DCCA.75
! CAL3DCCA.76
REAL PSTAR(NP_FIELD) ! IN Surface pressure CAL3DCCA.77
& ,AKM12(NLEV+1) ! IN Hybrid co-ord coeffs to define CAL3DCCA.78
& ,BKM12(NLEV+1) ! pressure at level k-1/2 CAL3DCCA.79
& ,CCA_2D(NPNTS) ! IN 2D convective cloud amount CAL3DCCA.80
!------------------------------------------------------------------ CAL3DCCA.81
! Array arguments with intent(out): CAL3DCCA.82
!------------------------------------------------------------------ CAL3DCCA.83
REAL CCA_3D(NP_FIELD,NLEV) ! OUT Convective cloud amount on CAL3DCCA.84
! ! model levels CAL3DCCA.85
!------------------------------------------------------------------ CAL3DCCA.86
! Local parameters: CAL3DCCA.87
!------------------------------------------------------------------ CAL3DCCA.88
REAL DEEP_DP ! Depth cloud must reach to be 'deep' CAL3DCCA.89
! CAL3DCCA.90
PARAMETER (DEEP_DP = 50000) ! Critical depth of clouds = 500hPa CAL3DCCA.91
!------------------------------------------------------------------ CAL3DCCA.92
! Local scalars: CAL3DCCA.93
!------------------------------------------------------------------ CAL3DCCA.94
INTEGER ANVIL_LEV ! Base level of 'anvil' if it is to CAL3DCCA.95
! ! be applied. CAL3DCCA.96
INTEGER I,K ! Loop counters CAL3DCCA.97
! CAL3DCCA.98
REAL ANVIL_DEPTH CAL3DCCA.99
& ,P_CLOUD_BASE CAL3DCCA.100
& ,P_CLOUD_TOP CAL3DCCA.101
! CAL3DCCA.102
LOGICAL DEEP CAL3DCCA.103
! CAL3DCCA.104
!====================================================================== CAL3DCCA.105
! ANVIL CLOUD CALCULATION: CAL3DCCA.106
! If cloud base is in the PBL, and cloud top is above (or at) CAL3DCCA.107
! the freezing level, then add an anvil cloud by increasing the CAL3DCCA.108
! cloud fraction linearly from freezing lev to cloud top. Also CAL3DCCA.109
! decrease the cloud fraction below this level to represent the CAL3DCCA.110
! 'tower'. CAL3DCCA.111
!====================================================================== CAL3DCCA.112
! CAL3DCCA.113
IF (L_CLOUD_DEEP) THEN AJX3F405.155
DO I = 1,NPNTS CAL3DCCA.114
ANVIL_DEPTH = 0 CAL3DCCA.115
ANVIL_LEV = 0 CAL3DCCA.116
DEEP = .FALSE. CAL3DCCA.117
C---------------------------------------------------------------------- CAL3DCCA.118
C Calculate cloud depth: CAL3DCCA.119
C---------------------------------------------------------------------- CAL3DCCA.120
IF (CCA_2D(I).GT.0.0) THEN CAL3DCCA.121
P_CLOUD_BASE = AKM12(CLOUD_BASE(I)) + CAL3DCCA.122
& BKM12(CLOUD_BASE(I))*PSTAR(I) CAL3DCCA.123
P_CLOUD_TOP = AKM12(CLOUD_TOP(I)+1) + CAL3DCCA.124
& BKM12(CLOUD_TOP(I)+1)*PSTAR(I) CAL3DCCA.125
DEEP = (P_CLOUD_BASE - P_CLOUD_TOP) .GE. DEEP_DP CAL3DCCA.126
C---------------------------------------------------------------------- CAL3DCCA.127
C Check to see if cloud is deep and above freezing level: CAL3DCCA.128
C---------------------------------------------------------------------- CAL3DCCA.129
IF ( ( CLOUD_BASE(I) .LT. NBL ) .AND. CAL3DCCA.130
& ( CLOUD_TOP(I) .GT. FREEZE_LEV(I) ) .AND. CAL3DCCA.131
& ( DEEP ) ) THEN CAL3DCCA.132
C---------------------------------------------------------------------- CAL3DCCA.133
C Define anvil base level as freezing level or cloud base if above FL: CAL3DCCA.134
C---------------------------------------------------------------------- CAL3DCCA.135
ANVIL_DEPTH = ( CLOUD_TOP(I) - FREEZE_LEV(I) ) CAL3DCCA.136
ANVIL_LEV = FREEZE_LEV(I) CAL3DCCA.137
IF ( ANVIL_DEPTH .GT. (CLOUD_TOP(I)-CLOUD_BASE(I)) ) THEN CAL3DCCA.138
ANVIL_DEPTH = CLOUD_TOP(I)-CLOUD_BASE(I) CAL3DCCA.139
ANVIL_LEV = CLOUD_BASE(I) CAL3DCCA.140
ENDIF CAL3DCCA.141
C---------------------------------------------------------------------- CAL3DCCA.142
C Apply wedge-shaped anvil from anvil base to cloud top: CAL3DCCA.143
C---------------------------------------------------------------------- CAL3DCCA.144
DO K = ANVIL_LEV,(CLOUD_TOP(I) - 1) CAL3DCCA.145
CCA_3D(I,K) = (ANVIL_FACTOR - TOWER_FACTOR) CAL3DCCA.146
& * CCA_2D(I) CAL3DCCA.147
& * (K - ANVIL_LEV + 1)/ANVIL_DEPTH CAL3DCCA.148
& + (CCA_2D(I) * TOWER_FACTOR) CAL3DCCA.149
IF (CCA_3D(I,K) .GE. 1.0) THEN CAL3DCCA.150
CCA_3D(I,K) = 0.99 CAL3DCCA.151
ENDIF CAL3DCCA.152
ENDDO CAL3DCCA.153
C---------------------------------------------------------------------- CAL3DCCA.154
C ...and tower below (i.e. from cloud base to anvil base): CAL3DCCA.155
C---------------------------------------------------------------------- CAL3DCCA.156
DO K = CLOUD_BASE(I),ANVIL_LEV-1 CAL3DCCA.157
CCA_3D(I,K) = TOWER_FACTOR * CCA_2D(I) CAL3DCCA.158
ENDDO CAL3DCCA.159
ELSE CAL3DCCA.160
C---------------------------------------------------------------------- CAL3DCCA.161
C If cloud is not 'deep' keep old fraction, but put on model levels: CAL3DCCA.162
C---------------------------------------------------------------------- CAL3DCCA.163
DO K = CLOUD_BASE(I),(CLOUD_TOP(I) - 1) CAL3DCCA.164
CCA_3D(I,K) = CCA_2D(I) CAL3DCCA.165
ENDDO CAL3DCCA.166
ENDIF CAL3DCCA.167
C---------------------------------------------------------------------- CAL3DCCA.168
C Finally check there is no cloud below cloud base or above cloud top! CAL3DCCA.169
C---------------------------------------------------------------------- CAL3DCCA.170
DO K = 1,(CLOUD_BASE(I)-1) CAL3DCCA.171
CCA_3D(I,K) = 0.0 CAL3DCCA.172
END DO CAL3DCCA.173
DO K = CLOUD_TOP(I),NLEV CAL3DCCA.174
CCA_3D(I,K) = 0.0 CAL3DCCA.175
END DO CAL3DCCA.176
ENDIF CAL3DCCA.177
ENDDO CAL3DCCA.178
ELSE AJX3F405.156
DO I = 1,NPNTS AJX3F405.157
ANVIL_DEPTH = 0 AJX3F405.158
ANVIL_LEV = 0 AJX3F405.159
!---------------------------------------------------------------------- AJX3F405.160
! Calculate cloud depth: AJX3F405.161
!---------------------------------------------------------------------- AJX3F405.162
IF (CCA_2D(I).GT.0.0) THEN AJX3F405.163
!---------------------------------------------------------------------- AJX3F405.164
! Check to see if cloud is deep and above freezing level: AJX3F405.165
!---------------------------------------------------------------------- AJX3F405.166
IF ( ( CLOUD_BASE(I) .LT. NBL ) .AND. AJX3F405.167
& ( CLOUD_TOP(I) .GT. FREEZE_LEV(I) ) ) THEN AJX3F405.168
!---------------------------------------------------------------------- AJX3F405.169
! Define anvil base level as freezing level or cloud base if above FL: AJX3F405.170
!---------------------------------------------------------------------- AJX3F405.171
ANVIL_DEPTH = ( CLOUD_TOP(I) - FREEZE_LEV(I) ) AJX3F405.172
ANVIL_LEV = FREEZE_LEV(I) AJX3F405.173
IF ( ANVIL_DEPTH .GT. (CLOUD_TOP(I)-CLOUD_BASE(I)) ) THEN AJX3F405.174
ANVIL_DEPTH = CLOUD_TOP(I)-CLOUD_BASE(I) AJX3F405.175
ANVIL_LEV = CLOUD_BASE(I) AJX3F405.176
ENDIF AJX3F405.177
!---------------------------------------------------------------------- AJX3F405.178
! Apply wedge-shaped anvil from anvil base to cloud top: AJX3F405.179
!---------------------------------------------------------------------- AJX3F405.180
DO K = ANVIL_LEV,(CLOUD_TOP(I) - 1) AJX3F405.181
CCA_3D(I,K) = (ANVIL_FACTOR - TOWER_FACTOR) AJX3F405.182
& * CCA_2D(I) AJX3F405.183
& * (K - ANVIL_LEV + 1)/ANVIL_DEPTH AJX3F405.184
& + (CCA_2D(I) * TOWER_FACTOR) AJX3F405.185
IF (CCA_3D(I,K) .GE. 1.0) THEN AJX3F405.186
CCA_3D(I,K) = 0.99 AJX3F405.187
ENDIF AJX3F405.188
ENDDO AJX3F405.189
!---------------------------------------------------------------------- AJX3F405.190
! ...and tower below (i.e. from cloud base to anvil base): AJX3F405.191
!---------------------------------------------------------------------- AJX3F405.192
DO K = CLOUD_BASE(I),ANVIL_LEV-1 AJX3F405.193
CCA_3D(I,K) = TOWER_FACTOR * CCA_2D(I) AJX3F405.194
ENDDO AJX3F405.195
ELSE AJX3F405.196
!---------------------------------------------------------------------- AJX3F405.197
! If cloud does not satisfy anvil criteria, keep old fraction, but put AJX3F405.198
! on model levels: AJX3F405.199
!---------------------------------------------------------------------- AJX3F405.200
DO K = CLOUD_BASE(I),(CLOUD_TOP(I) - 1) AJX3F405.201
CCA_3D(I,K) = CCA_2D(I) AJX3F405.202
ENDDO AJX3F405.203
ENDIF AJX3F405.204
!---------------------------------------------------------------------- AJX3F405.205
! Finally check there is no cloud below cloud base or above cloud top! AJX3F405.206
!---------------------------------------------------------------------- AJX3F405.207
DO K = 1,(CLOUD_BASE(I)-1) AJX3F405.208
CCA_3D(I,K) = 0.0 AJX3F405.209
END DO AJX3F405.210
DO K = CLOUD_TOP(I),NLEV AJX3F405.211
CCA_3D(I,K) = 0.0 AJX3F405.212
END DO AJX3F405.213
ENDIF AJX3F405.214
ENDDO AJX3F405.215
ENDIF AJX3F405.216
C CAL3DCCA.179
C CAL3DCCA.180
C====================================================================== CAL3DCCA.181
C END OF ANVIL CALCULATION CAL3DCCA.182
C====================================================================== CAL3DCCA.183
C CAL3DCCA.184
RETURN CAL3DCCA.185
END CAL3DCCA.186
*ENDIF CAL3DCCA.187