*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.31
*IF DEF,A01_3A,OR,DEF,A02_3A GLBCT3A.3
C *****************************COPYRIGHT****************************** GLBCT3A.4
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. GLBCT3A.5
C GLBCT3A.6
C Use, duplication or disclosure of this code is subject to the GLBCT3A.7
C restrictions as set forth in the contract. GLBCT3A.8
C GLBCT3A.9
C Meteorological Office GLBCT3A.10
C London Road GLBCT3A.11
C BRACKNELL GLBCT3A.12
C Berkshire UK GLBCT3A.13
C RG12 2SZ GLBCT3A.14
C GLBCT3A.15
C If no contract has been raised with this copy of the code, the use, GLBCT3A.16
C duplication or disclosure of it is strictly prohibited. Permission GLBCT3A.17
C to do so must first be obtained in writing from the Head of Numerical GLBCT3A.18
C Modelling at the above address. GLBCT3A.19
C ******************************COPYRIGHT****************************** GLBCT3A.20
C GLBCT3A.21
!+ Subroutine to determine the global topmost cloudy layer. ADB2F404.562
! GLBCT3A.23
! Purpose: GLBCT3A.24
! The routine determines the topmost cloudy layer over the whole ADB2F404.563
! computational domain for use in configurations of the model where GLBCT3A.26
! results must be bit-reproducible irrespective of the number of GLBCT3A.27
! segments. GLBCT3A.28
! GLBCT3A.29
! Method: GLBCT3A.30
! The arrays LCA for layer cloud and CCT for convective cloud are GLBCT3A.31
! searched to determine the topmost layer occupied by cloud. GLBCT3A.32
! GLBCT3A.33
! Current Owner of Code: J. M. Edwards GLBCT3A.34
! GLBCT3A.35
! History: GLBCT3A.36
! Version Date Comment GLBCT3A.37
! 4.2 17-12-96 Original Code GLBCT3A.38
! (J. M. Edwards) GLBCT3A.39
! 4.3 17-04-97 Delete trailing blank l GSH1F403.1
! (A. Brady) GSH1F403.2
! 4.4 23-09-97 Lower limit set for ADB2F404.564
! searching. ADB2F404.565
! (J. M. Edwards) ADB2F404.566
! GLBCT3A.40
! Description of Code: GLBCT3A.41
! FORTRAN 77 with extensions listed in documentation. GLBCT3A.42
! GLBCT3A.43
!- --------------------------------------------------------------------- GLBCT3A.44
SUBROUTINE R2_GLOBAL_CLOUD_TOP(N_POINTS, NLEVS, NCLDS 1GLBCT3A.45
! Convective cloud Fields GLBCT3A.46
& , CCA, CCT GLBCT3A.47
! Layer cloud Fields GLBCT3A.48
& , LCA GLBCT3A.49
! Calculated top of cloud fields. GLBCT3A.50
& , GLOBAL_CLOUD_TOP GLBCT3A.51
! Size of arrays GLBCT3A.52
& , ND_POINTS GLBCT3A.53
& ) GLBCT3A.54
! GLBCT3A.55
! GLBCT3A.56
! GLBCT3A.57
IMPLICIT NONE GLBCT3A.58
! GLBCT3A.59
! GLBCT3A.60
! DUMMY ARGUMENTS GLBCT3A.61
! GLBCT3A.62
! SIZES OF ARRAYS. GLBCT3A.63
INTEGER !, INTENT(IN) GLBCT3A.64
& ND_POINTS GLBCT3A.65
! HORIZONTAL DIMENSION OF ARRAYS GLBCT3A.66
! GLBCT3A.67
INTEGER !, INTENT(IN) GLBCT3A.68
& N_POINTS GLBCT3A.69
! NUMBER OF POINTS TO CONSIDER GLBCT3A.70
& , NLEVS GLBCT3A.71
! NUMBER OF LEVELS CONSIDERED GLBCT3A.72
& , NCLDS GLBCT3A.73
! NUMBER OF CLOUDY LAYERS GLBCT3A.74
! GLBCT3A.75
! FIELDS FOR CONVECTIVE CLOUDS GLBCT3A.76
REAL !, INTENT(IN) GLBCT3A.77
& CCA(ND_POINTS) GLBCT3A.78
! AMOUNTS OF CONVECTIVE CLOUD GLBCT3A.79
INTEGER !, INTENT(IN) ADB2F403.1
& CCT(ND_POINTS) ADB2F403.2
! LEVEL OF TOP OF CONVECTIVE CLOUD GLBCT3A.81
! I.E. CONVECTIVE CLOUD REACHES THE BASE OF LAYER CCT, GLBCT3A.82
! BUT DOES NOT EXTEND INTO IT. GLBCT3A.83
! GLBCT3A.84
! FIELDS FOR STRATIFORM CLOUDS GLBCT3A.85
REAL !, INTENT(IN) GLBCT3A.86
& LCA(ND_POINTS, NCLDS) GLBCT3A.87
! AMOUNTS OF LAYER CLOUD GLBCT3A.88
! GLBCT3A.89
INTEGER !, INTENT(OUT) GLBCT3A.90
& GLOBAL_CLOUD_TOP GLBCT3A.91
! GLOBAL TOPMOST CLOUDY LEVEL GLBCT3A.92
! GLBCT3A.93
! GLBCT3A.94
! LOCAL VARIABLES GLBCT3A.95
INTEGER GLBCT3A.96
& L GLBCT3A.97
! LOOP VARIABLE GLBCT3A.98
LOGICAL GLBCT3A.99
& L_LAYER_CLEAR GLBCT3A.100
! FLAG FOR LAYER FREE OF CLOUDS GLBCT3A.101
! GLBCT3A.102
! GLBCT3A.103
! GLBCT3A.104
! INITIALIZE THE CLOUD-TOP TO THE LAYER ABOVE THAT IN WHICH CLOUDS ADB2F404.567
! ARE PERMITTED AND REDUCE UNTIL NON-EMPTY LAYERS ARE FOUND. ADB2F404.568
GLOBAL_CLOUD_TOP=NCLDS+1 GLBCT3A.107
L_LAYER_CLEAR=.TRUE. GLBCT3A.108
DO WHILE ( (L_LAYER_CLEAR).AND.(GLOBAL_CLOUD_TOP.GT.1) ) ADB2F404.569
GLOBAL_CLOUD_TOP=GLOBAL_CLOUD_TOP-1 GLBCT3A.110
DO L=1, N_POINTS GLBCT3A.111
L_LAYER_CLEAR=L_LAYER_CLEAR.AND. GLBCT3A.112
& (LCA(L, GLOBAL_CLOUD_TOP).LE.0.0E+00).AND. GLBCT3A.113
& ( (CCA(L).LE.0.0E+00).OR. GLBCT3A.114
& (CCT(L).LT.GLOBAL_CLOUD_TOP-1) ) GLBCT3A.115
ENDDO GLBCT3A.116
ENDDO GLBCT3A.117
! GLBCT3A.118
! GLBCT3A.119
! GLBCT3A.120
RETURN GLBCT3A.121
END GLBCT3A.122
*ENDIF DEF,A01_3A,OR,DEF,A02_3A GLBCT3A.123
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.32