*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.85
*IF DEF,A01_3A,OR,DEF,A02_3A SCLGE3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13858
C GTS2F400.13859
C Use, duplication or disclosure of this code is subject to the GTS2F400.13860
C restrictions as set forth in the contract. GTS2F400.13861
C GTS2F400.13862
C Meteorological Office GTS2F400.13863
C London Road GTS2F400.13864
C BRACKNELL GTS2F400.13865
C Berkshire UK GTS2F400.13866
C RG12 2SZ GTS2F400.13867
C GTS2F400.13868
C If no contract has been raised with this copy of the code, the use, GTS2F400.13869
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13870
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13871
C Modelling at the above address. GTS2F400.13872
C ******************************COPYRIGHT****************************** GTS2F400.13873
C GTS2F400.13874
!+ Subroutine to set geometry of clouds. SCLGE3A.3
! SCLGE3A.4
! Method: SCLGE3A.5
! For use in multi-column mode arrays are set for each layer SCLGE3A.6
! pointing to profiles which have non-negligible clear or SCLGE3A.7
! cloudy fractions. The topmost cloudy layers are also SCLGE3A.8
! detected. SCLGE3A.9
! SCLGE3A.10
! Current Owner of Code: J. M. Edwards SCLGE3A.11
! SCLGE3A.12
! History: SCLGE3A.13
! Version Date Comment SCLGE3A.14
! 4.0 27-07-95 Original Code SCLGE3A.15
! (J. M. Edwards) SCLGE3A.16
! 4.2 Nov. 96 T3E migration: CALL WHENFGT,WHENFLE GSS2F402.91
! replaced by portable fortran code. GSS2F402.92
! S.J.Swarbrick GSS2F402.93
! SCLGE3A.17
! Description of Code: SCLGE3A.18
! FORTRAN 77 with extensions listed in documentation. SCLGE3A.19
! SCLGE3A.20
!- --------------------------------------------------------------------- SCLGE3A.21
SUBROUTINE SET_CLOUD_GEOMETRY(N_PROFILE, N_LAYER 1SCLGE3A.22
& , L_GLOBAL_CLOUD_TOP, N_CLOUD_TOP_GLOBAL ADB1F402.914
& , W_CLOUD SCLGE3A.23
& , N_CLOUD_PROFILE, I_CLOUD_PROFILE SCLGE3A.24
& , N_CLOUD_TOP SCLGE3A.25
& , N_FREE_PROFILE, I_FREE_PROFILE SCLGE3A.26
& , NPD_PROFILE, NPD_LAYER SCLGE3A.27
& ) SCLGE3A.28
! SCLGE3A.29
! SCLGE3A.30
! SCLGE3A.31
IMPLICIT NONE SCLGE3A.32
! SCLGE3A.33
! SCLGE3A.34
! SIZES OF DUMMY ARRAYS. SCLGE3A.35
INTEGER !, INTENT(IN) SCLGE3A.36
& NPD_PROFILE SCLGE3A.37
! MAXIMUM NUMBER OF PROFILES SCLGE3A.38
& , NPD_LAYER SCLGE3A.39
! MAXIMUM NUMBER OF LAYERS SCLGE3A.40
! INCLUDE COMDECKS. SCLGE3A.41
*CALL PRMCH3A 
SCLGE3A.42
*CALL PRECSN3A SCLGE3A.43
! SCLGE3A.44
! DUMMY ARGUMENTS. SCLGE3A.45
INTEGER !, INTENT(IN) SCLGE3A.46
& N_PROFILE SCLGE3A.47
! NUMBER OF PROFILES SCLGE3A.48
& , N_LAYER SCLGE3A.49
! NUMBER OF LAYERS SCLGE3A.50
LOGICAL !, INTENT(IN) ADB1F402.915
& L_GLOBAL_CLOUD_TOP ADB1F402.916
! FLAG TO USE A GLOBAL VALUE FOR THE TOPS OF CLOUDS ADB1F402.917
INTEGER !, INTENT(IN) ADB1F402.918
& N_CLOUD_TOP_GLOBAL ADB1F402.919
! GLOBAL TOPMOST CLOUDY LAYER ADB1F402.920
! ADB1F402.921
INTEGER !, INTENT(OUT) SCLGE3A.51
& N_CLOUD_TOP SCLGE3A.52
! TOPMOST CLOUDY LAYER SCLGE3A.53
& , N_FREE_PROFILE(NPD_LAYER) SCLGE3A.54
! NUMBER OF FREE PROFILES SCLGE3A.55
& , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER) SCLGE3A.56
! CLOUD-FREE PROFILES SCLGE3A.57
& , N_CLOUD_PROFILE(NPD_LAYER) SCLGE3A.58
! NUMBER OF CLOUDY PROFILES SCLGE3A.59
& , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER) SCLGE3A.60
! PROFILES CONTAINING CLOUDS SCLGE3A.61
REAL !, INTENT(IN) SCLGE3A.62
& W_CLOUD(NPD_PROFILE, NPD_LAYER) SCLGE3A.63
! AMOUNTS OF CLOUD SCLGE3A.64
! SCLGE3A.65
! SCLGE3A.66
! LOCAL VARIABLES. SCLGE3A.67
INTEGER SCLGE3A.68
& I,J,L GSS2F402.94
! LOOP VARIABLE SCLGE3A.70
! SCLGE3A.71
! SCLGE3A.72
! SUBROUTINES CALLED: SCLGE3A.73
! SCLGE3A.76
! SCLGE3A.77
! SCLGE3A.78
DO I=1, N_LAYER SCLGE3A.79
! GSS2F402.97
J =1 GSS2F402.98
N_CLOUD_PROFILE(I)=0 GSS2F402.99
DO L =1,N_PROFILE GSS2F402.100
IF (W_CLOUD(L,I).GT.TOL_TEST) THEN GSS2F402.101
I_CLOUD_PROFILE(J,I)=L GSS2F402.102
J =J+1 GSS2F402.103
N_CLOUD_PROFILE( I)=N_CLOUD_PROFILE(I)+1 GSS2F402.104
END IF GSS2F402.105
END DO GSS2F402.106
! GSS2F402.107
! GSS2F402.110
J =1 GSS2F402.111
N_FREE_PROFILE(I)=0 GSS2F402.112
DO L =1,N_PROFILE GSS2F402.113
IF (W_CLOUD(L,I).LE.TOL_TEST) THEN GSS2F402.114
I_FREE_PROFILE(J,I)=L GSS2F402.115
J =J+1 GSS2F402.116
N_FREE_PROFILE( I)=N_FREE_PROFILE(I)+1 GSS2F402.117
END IF GSS2F402.118
END DO GSS2F402.119
! GSS2F402.120
ENDDO SCLGE3A.84
! SCLGE3A.85
IF (L_GLOBAL_CLOUD_TOP) THEN ADB1F402.922
N_CLOUD_TOP=N_CLOUD_TOP_GLOBAL ADB1F402.923
ELSE ADB1F402.924
N_CLOUD_TOP=1 ADB1F402.925
DO WHILE ( (N_CLOUD_TOP.LT.N_LAYER).AND. ADB1F402.926
& (N_CLOUD_PROFILE(N_CLOUD_TOP).EQ.0) ) ADB1F402.927
N_CLOUD_TOP=N_CLOUD_TOP+1 ADB1F402.928
ENDDO ADB1F402.929
ENDIF ADB1F402.930
! SCLGE3A.93
! SCLGE3A.94
! SCLGE3A.95
RETURN SCLGE3A.96
END SCLGE3A.97
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SCLGE3A.98
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.86