*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.87
*IF DEF,A01_3A,OR,DEF,A02_3A SCLPT3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13875
C GTS2F400.13876
C Use, duplication or disclosure of this code is subject to the GTS2F400.13877
C restrictions as set forth in the contract. GTS2F400.13878
C GTS2F400.13879
C Meteorological Office GTS2F400.13880
C London Road GTS2F400.13881
C BRACKNELL GTS2F400.13882
C Berkshire UK GTS2F400.13883
C RG12 2SZ GTS2F400.13884
C GTS2F400.13885
C If no contract has been raised with this copy of the code, the use, GTS2F400.13886
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13887
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13888
C Modelling at the above address. GTS2F400.13889
C ******************************COPYRIGHT****************************** GTS2F400.13890
C GTS2F400.13891
!+ Subroutine to set pointers to types of clouds SCLPT3A.3
! SCLPT3A.4
! Method: SCLPT3A.5
! The types of condensate included are examined. Their phases SCLPT3A.6
! are set and depending on the representation of clouds adopted SCLPT3A.7
! it is determined to which type of cloud they contribute. SCLPT3A.8
! SCLPT3A.9
! Current Owner of Code: J. M. Edwards SCLPT3A.10
! SCLPT3A.11
! History: SCLPT3A.12
! Version Date Comment SCLPT3A.13
! 4.0 27-07-95 Original Code SCLPT3A.14
! (J. M. Edwards) SCLPT3A.15
! SCLPT3A.16
! Description of Code: SCLPT3A.17
! FORTRAN 77 with extensions listed in documentation. SCLPT3A.18
! SCLPT3A.19
!- --------------------------------------------------------------------- SCLPT3A.20
SUBROUTINE SET_CLOUD_POINTER(IERR 1SCLPT3A.21
& , N_CONDENSED, TYPE_CONDENSED, I_CLOUD_REPRESENTATION SCLPT3A.22
& , L_DROP, L_ICE SCLPT3A.23
& , I_PHASE_CMP, I_CLOUD_TYPE, L_CLOUD_CMP SCLPT3A.24
& ) SCLPT3A.25
! SCLPT3A.26
! SCLPT3A.27
! SCLPT3A.28
IMPLICIT NONE SCLPT3A.29
! SCLPT3A.30
! SCLPT3A.31
! SCLPT3A.32
! INCLUDE COMDECKS SCLPT3A.33
*CALL STDIO3A 
SCLPT3A.34
*CALL ERROR3A SCLPT3A.35
*CALL DIMFIX3A SCLPT3A.36
*CALL PHASE3A SCLPT3A.37
*CALL CLDCMP3A SCLPT3A.38
*CALL CLREPP3A SCLPT3A.39
*CALL CLDTYP3A SCLPT3A.40
! SCLPT3A.41
! DUMMY VARIABLES. SCLPT3A.42
INTEGER !, INTENT(OUT) SCLPT3A.43
& IERR SCLPT3A.44
! ERROR FLAG SCLPT3A.45
INTEGER !, INTENT(IN) SCLPT3A.46
& N_CONDENSED SCLPT3A.47
! NUMBER OF CONDENSED COMPONENTS SCLPT3A.48
& , TYPE_CONDENSED(NPD_CLOUD_COMPONENT) SCLPT3A.49
! TYPES OF COMPONENTS SCLPT3A.50
& , I_CLOUD_REPRESENTATION SCLPT3A.51
! REPRESENTATION OF CLOUDS USED SCLPT3A.52
LOGICAL !, INTENT(IN) SCLPT3A.53
& L_DROP SCLPT3A.54
! FLAG FOR INCLUSION OF DROPLETS SCLPT3A.55
& , L_ICE SCLPT3A.56
! FLAG FOR INCLUSION OF ICE CRYSTALS SCLPT3A.57
! SCLPT3A.58
INTEGER !, INTENT(OUT) SCLPT3A.59
& I_PHASE_CMP(NPD_CLOUD_COMPONENT) SCLPT3A.60
! PHASES OF COMPONENTS SCLPT3A.61
& , I_CLOUD_TYPE(NPD_CLOUD_COMPONENT) SCLPT3A.62
! TYPES OF CLOUD TO WHICH EACH COMPONENT CONTRIBUTES SCLPT3A.63
LOGICAL !, INTENT(OUT) SCLPT3A.64
& L_CLOUD_CMP(NPD_CLOUD_COMPONENT) SCLPT3A.65
! LOGICAL SWITCHES TO INCLUDE COMPONENTS SCLPT3A.66
! SCLPT3A.67
! SCLPT3A.68
! LOCAL VARIABLES SCLPT3A.69
INTEGER SCLPT3A.70
& K SCLPT3A.71
! LOOP VARIABLE SCLPT3A.72
! SCLPT3A.73
*CALL CLREPD3A SCLPT3A.74
! SCLPT3A.75
! SCLPT3A.76
! SCLPT3A.77
DO K=1, N_CONDENSED SCLPT3A.78
! SCLPT3A.79
I_CLOUD_TYPE(K)=IP_CLOUD_TYPE_MAP(TYPE_CONDENSED(K) SCLPT3A.80
& , I_CLOUD_REPRESENTATION) SCLPT3A.81
! SCLPT3A.82
! CHECK FOR 0 FLAGGING ILLEGAL TYPES. SCLPT3A.83
IF (I_CLOUD_TYPE(K).EQ.0) THEN SCLPT3A.84
WRITE(IU_ERR, '(/A)') SCLPT3A.85
& '*** ERROR: A COMPONENT IS NOT COMPATIBLE WITH THE' SCLPT3A.86
& //'REPRESENTATION OF CLOUDS SELECTED.' SCLPT3A.87
IERR=I_ERR_FATAL SCLPT3A.88
RETURN SCLPT3A.89
ENDIF SCLPT3A.90
! SCLPT3A.91
IF (TYPE_CONDENSED(K).EQ.IP_CLCMP_ST_WATER) THEN SCLPT3A.92
! SCLPT3A.93
I_PHASE_CMP(K)=IP_PHASE_WATER SCLPT3A.94
L_CLOUD_CMP(K)=L_DROP SCLPT3A.95
! SCLPT3A.96
ELSE IF (TYPE_CONDENSED(K).EQ.IP_CLCMP_ST_ICE) THEN SCLPT3A.97
! SCLPT3A.98
I_PHASE_CMP(K)=IP_PHASE_ICE SCLPT3A.99
L_CLOUD_CMP(K)=L_ICE SCLPT3A.100
! SCLPT3A.101
ELSE IF (TYPE_CONDENSED(K).EQ.IP_CLCMP_CNV_WATER) THEN SCLPT3A.102
! SCLPT3A.103
I_PHASE_CMP(K)=IP_PHASE_WATER SCLPT3A.104
L_CLOUD_CMP(K)=L_DROP SCLPT3A.105
! SCLPT3A.106
ELSE IF (TYPE_CONDENSED(K).EQ.IP_CLCMP_CNV_ICE) THEN SCLPT3A.107
! SCLPT3A.108
I_PHASE_CMP(K)=IP_PHASE_ICE SCLPT3A.109
L_CLOUD_CMP(K)=L_ICE SCLPT3A.110
! SCLPT3A.111
ENDIF SCLPT3A.112
! SCLPT3A.113
ENDDO SCLPT3A.114
! SCLPT3A.115
! SCLPT3A.116
! SCLPT3A.117
RETURN SCLPT3A.118
END SCLPT3A.119
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SCLPT3A.120
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.88