*IF DEF,A70_1A,OR,DEF,A70_1B                                               APB4F405.1      
*IF DEF,A01_3A,OR,DEF,A02_3A                                               AGGCLD3A.3      
C *****************************COPYRIGHT******************************     AGGCLD3A.4      
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved.    AGGCLD3A.5      
C                                                                          AGGCLD3A.6      
C Use, duplication or disclosure of this code is subject to the            AGGCLD3A.7      
C restrictions as set forth in the contract.                               AGGCLD3A.8      
C                                                                          AGGCLD3A.9      
C                Meteorological Office                                     AGGCLD3A.10     
C                London Road                                               AGGCLD3A.11     
C                BRACKNELL                                                 AGGCLD3A.12     
C                Berkshire UK                                              AGGCLD3A.13     
C                RG12 2SZ                                                  AGGCLD3A.14     
C                                                                          AGGCLD3A.15     
C If no contract has been raised with this copy of the code, the use,      AGGCLD3A.16     
C duplication or disclosure of it is strictly prohibited.  Permission      AGGCLD3A.17     
C to do so must first be obtained in writing from the Head of Numerical    AGGCLD3A.18     
C Modelling at the above address.                                          AGGCLD3A.19     
C ******************************COPYRIGHT******************************    AGGCLD3A.20     
C                                                                          AGGCLD3A.21     
!+ Subroutine to aggregate clouds into regions.                            AGGCLD3A.22     
!                                                                          AGGCLD3A.23     
! Method:                                                                  AGGCLD3A.24     
!       The clouds in a layer are combined in groups to form regions       AGGCLD3A.25     
!       which will be considered as bulk entities in the solution of the   AGGCLD3A.26     
!       equation of transfer. The extents of these regions are also        AGGCLD3A.27     
!       determined.                                                        AGGCLD3A.28     
!                                                                          AGGCLD3A.29     
! Current Owner of Code: J. M. Edwards                                     AGGCLD3A.30     
!                                                                          AGGCLD3A.31     
! History:                                                                 AGGCLD3A.32     
!       Version         Date                    Comment                    AGGCLD3A.33     
!       HADAM3          05-06-96                Original Code              AGGCLD3A.34     
!                                               (J. M. Edwards)            AGGCLD3A.35     
!                                                                          AGGCLD3A.36     
! Description of Code:                                                     AGGCLD3A.37     
!   FORTRAN 77  with extensions listed in documentation.                   AGGCLD3A.38     
!                                                                          AGGCLD3A.39     
!- ---------------------------------------------------------------------   AGGCLD3A.40     

      SUBROUTINE AGGREGATE_CLOUD(IERR                                       1AGGCLD3A.41     
     &   , N_PROFILE, N_LAYER, N_CLOUD_TOP                                 AGGCLD3A.42     
     &   , I_CLOUD, I_CLOUD_REPRESENTATION, N_CLOUD_TYPE                   AGGCLD3A.43     
     &   , FRAC_CLOUD                                                      AGGCLD3A.44     
     &   , I_REGION_CLOUD, FRAC_REGION                                     AGGCLD3A.45     
     &   , NPD_PROFILE, NPD_LAYER                                          AGGCLD3A.46     
     &   )                                                                 AGGCLD3A.47     
!                                                                          AGGCLD3A.48     
!                                                                          AGGCLD3A.49     
!                                                                          AGGCLD3A.50     
      IMPLICIT NONE                                                        AGGCLD3A.51     
!                                                                          AGGCLD3A.52     
!                                                                          AGGCLD3A.53     
!     DUMMY ARRAY SIZES                                                    AGGCLD3A.54     
      INTEGER   !, INTENT(IN)                                              AGGCLD3A.55     
     &     NPD_PROFILE                                                     AGGCLD3A.56     
!             MAXIMUM NUMBER OF PROFILES                                   AGGCLD3A.57     
     &   , NPD_LAYER                                                       AGGCLD3A.58     
!             MAXIMUM NUMBER OF LAYERS                                     AGGCLD3A.59     
!                                                                          AGGCLD3A.60     
!     INCLUDE COMDECKS                                                     AGGCLD3A.61     
*CALL STDIO3A                                                              AGGCLD3A.62     
*CALL ERROR3A                                                              AGGCLD3A.63     
*CALL DIMFIX3A                                                             AGGCLD3A.64     
*CALL CLREPP3A                                                             AGGCLD3A.65     
*CALL CLDTYP3A                                                             AGGCLD3A.66     
*CALL CLSCHM3A                                                             AGGCLD3A.67     
*CALL CLDREG3A                                                             AGGCLD3A.68     
!                                                                          AGGCLD3A.69     
!     DUMMY VARIABLES.                                                     AGGCLD3A.70     
      INTEGER   !, INTENT(OUT)                                             AGGCLD3A.71     
     &     IERR                                                            AGGCLD3A.72     
!             ERROR FLAG                                                   AGGCLD3A.73     
      INTEGER   !, INTENT(IN)                                              AGGCLD3A.74     
     &     N_PROFILE                                                       AGGCLD3A.75     
!             NUMBER OF PROFILES                                           AGGCLD3A.76     
     &   , N_LAYER                                                         AGGCLD3A.77     
!             NUMBER OF LAYERS                                             AGGCLD3A.78     
     &   , N_CLOUD_TOP                                                     AGGCLD3A.79     
!             TOPMOST CLOUDY LAYER                                         AGGCLD3A.80     
      INTEGER   !, INTENT(IN)                                              AGGCLD3A.81     
     &     I_CLOUD                                                         AGGCLD3A.82     
!             CLOUD SCHEME USED                                            AGGCLD3A.83     
     &   , I_CLOUD_REPRESENTATION                                          AGGCLD3A.84     
!             REPRESENTATION OF CLOUDS USED                                AGGCLD3A.85     
     &   , N_CLOUD_TYPE                                                    AGGCLD3A.86     
!             NUMBER OF TYPES OF CLOUD                                     AGGCLD3A.87     
!                                                                          AGGCLD3A.88     
      REAL      !, INTENT(OUT)                                             AGGCLD3A.89     
     &     FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)              AGGCLD3A.90     
!             FRACTIONS OF EACH TYPE OF CLOUD                              AGGCLD3A.91     
!                                                                          AGGCLD3A.92     
      INTEGER   !, INTENT(OUT)                                             AGGCLD3A.93     
     &     I_REGION_CLOUD(NPD_CLOUD_TYPE)                                  AGGCLD3A.94     
!             REGIONS IN WHICH PARTICULAR TYPES OF CLOUD FALL              AGGCLD3A.95     
      REAL      !, INTENT(OUT)                                             AGGCLD3A.96     
     &     FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION)                 AGGCLD3A.97     
!             FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION             AGGCLD3A.98     
!                                                                          AGGCLD3A.99     
!                                                                          AGGCLD3A.100    
!     LOCAL VARIABLES                                                      AGGCLD3A.101    
      INTEGER                                                              AGGCLD3A.102    
     &     I                                                               AGGCLD3A.103    
!            LOOP VARIABLE                                                 AGGCLD3A.104    
     &   , L                                                               AGGCLD3A.105    
!            LOOP VARIABLE                                                 AGGCLD3A.106    
     &   , K                                                               AGGCLD3A.107    
!            LOOP VARIABLE                                                 AGGCLD3A.108    
!                                                                          AGGCLD3A.109    
!                                                                          AGGCLD3A.110    
!                                                                          AGGCLD3A.111    
      IF (I_CLOUD.EQ.IP_CLOUD_TRIPLE) THEN                                 AGGCLD3A.112    
!                                                                          AGGCLD3A.113    
         IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) THEN                 AGGCLD3A.114    
!                                                                          AGGCLD3A.115    
            DO K=1, N_CLOUD_TYPE                                           AGGCLD3A.116    
               IF (K.EQ.IP_CLOUD_TYPE_SW) THEN                             AGGCLD3A.117    
                  I_REGION_CLOUD(K)=IP_REGION_STRAT                        AGGCLD3A.118    
               ELSE IF (K.EQ.IP_CLOUD_TYPE_SI) THEN                        AGGCLD3A.119    
                  I_REGION_CLOUD(K)=IP_REGION_STRAT                        AGGCLD3A.120    
               ELSE IF (K.EQ.IP_CLOUD_TYPE_CW) THEN                        AGGCLD3A.121    
                  I_REGION_CLOUD(K)=IP_REGION_CONV                         AGGCLD3A.122    
               ELSE IF (K.EQ.IP_CLOUD_TYPE_CI) THEN                        AGGCLD3A.123    
                  I_REGION_CLOUD(K)=IP_REGION_CONV                         AGGCLD3A.124    
               ENDIF                                                       AGGCLD3A.125    
            ENDDO                                                          AGGCLD3A.126    
!                                                                          AGGCLD3A.127    
            DO I=N_CLOUD_TOP, N_LAYER                                      AGGCLD3A.128    
               DO L=1, N_PROFILE                                           AGGCLD3A.129    
                  FRAC_REGION(L, I, IP_REGION_STRAT)                       AGGCLD3A.130    
     &               =FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SW)                   AGGCLD3A.131    
     &               +FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SI)                   AGGCLD3A.132    
                  FRAC_REGION(L, I, IP_REGION_CONV)                        AGGCLD3A.133    
     &               =FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CW)                   AGGCLD3A.134    
     &               +FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CI)                   AGGCLD3A.135    
               ENDDO                                                       AGGCLD3A.136    
            ENDDO                                                          AGGCLD3A.137    
!                                                                          AGGCLD3A.138    
         ELSE IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CONV_STRAT) THEN      AGGCLD3A.139    
!                                                                          AGGCLD3A.140    
            DO K=1, N_CLOUD_TYPE                                           AGGCLD3A.141    
               IF (K.EQ.IP_CLOUD_TYPE_STRAT) THEN                          AGGCLD3A.142    
                  I_REGION_CLOUD(K)=IP_REGION_STRAT                        AGGCLD3A.143    
               ELSE IF (K.EQ.IP_CLOUD_TYPE_CONV) THEN                      AGGCLD3A.144    
                  I_REGION_CLOUD(K)=IP_REGION_CONV                         AGGCLD3A.145    
               ENDIF                                                       AGGCLD3A.146    
            ENDDO                                                          AGGCLD3A.147    
!                                                                          AGGCLD3A.148    
            DO I=N_CLOUD_TOP, N_LAYER                                      AGGCLD3A.149    
               DO L=1, N_PROFILE                                           AGGCLD3A.150    
                  FRAC_REGION(L, I, IP_REGION_STRAT)                       AGGCLD3A.151    
     &               =FRAC_CLOUD(L, I, IP_CLOUD_TYPE_STRAT)                AGGCLD3A.152    
                  FRAC_REGION(L, I, IP_REGION_CONV)                        AGGCLD3A.153    
     &               =FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CONV)                 AGGCLD3A.154    
               ENDDO                                                       AGGCLD3A.155    
            ENDDO                                                          AGGCLD3A.156    
!                                                                          AGGCLD3A.157    
!                                                                          AGGCLD3A.158    
         ELSE                                                              AGGCLD3A.159    
            WRITE(IU_ERR, '(/A)')                                          AGGCLD3A.160    
     &         '*** ERROR: THIS REPRESENTATION OF CLOUDS IS NOT '          AGGCLD3A.161    
     &         //'COMPATIBLE WITH THE TRIPLE OVERLAP.'                     AGGCLD3A.162    
            IERR=I_ERR_FATAL                                               AGGCLD3A.163    
            RETURN                                                         AGGCLD3A.164    
         ENDIF                                                             AGGCLD3A.165    
!                                                                          AGGCLD3A.166    
      ENDIF                                                                AGGCLD3A.167    
!                                                                          AGGCLD3A.168    
!                                                                          AGGCLD3A.169    
!                                                                          AGGCLD3A.170    
      RETURN                                                               AGGCLD3A.171    
      END                                                                  AGGCLD3A.172    
*ENDIF DEF,A01_3A,OR,DEF,A02_3A                                            AGGCLD3A.173    
*ENDIF DEF,A70_1A,OR,DEF,A70_1B                                            APB4F405.2