!+ Subroutine to calculate cloudy two-stream coefficients.
!
! Method:
!	The coeffients for each type of cloud are determined and
!	averaged.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date			Comment
!	1.0		12-04-95		First Version under RCS
!						(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE TWO_COEFF_CLOUD(IERR
     &   , N_PROFILE, I_LAYER_FIRST, I_LAYER_LAST
     &   , I_2STREAM, L_IR_SOURCE_QUAD, N_SOURCE_COEFF
     &   , N_CLOUD_TYPE, FRAC_CLOUD
     &   , ASYMMETRY_CLOUD, OMEGA_CLOUD, TAU_CLOUD
     &   , ISOLIR, SEC_0
     &   , TRANS_CLOUD, REFLECT_CLOUD, TRANS_0_CLOUD
     &   , SOURCE_COEFF_CLOUD
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/dimensions_fixed.pcf'
      INCLUDE 'incl/spectral_region.pcf'
      INCLUDE 'incl/error.pcf'
!
!
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_PROFILE
!             NUMBER OF PROFILES
     &   , I_LAYER_FIRST
!             FIRST LAYER TO CONSIDER
     &   , I_LAYER_LAST
!             LAST LAYER TO CONSIDER
     &   , ISOLIR
!             SPECTRAL REGION
     &   , N_CLOUD_TYPE
!             NUMBER OF TYPES OF CLOUDS
     &   , I_2STREAM
!             TWO STREAM SCHEME
     &   , N_SOURCE_COEFF
!             NUMBER OF SOURCE COEFFICIENTS
!
      LOGICAL	!, INTENT(IN)
     &     L_IR_SOURCE_QUAD
!             USE A QUADRATIC SOURCE IN THE INFRA-RED
!
!     OPTICAL PROPERTIES OF LAYER:
      REAL*8	!, INTENT(IN)
     &     FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             FRACTIONS OF DIFFERENT TYPES OF CLOUDS
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             ASYMMETRY FACTOR
     &   , OMEGA_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             ALBEDO OF SINGLE SCATTERING
     &   , TAU_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             OPTICAL DEPTH
!
!     SOLAR BEAM
      REAL*8	!, INTENT(IN)
     &     SEC_0(NPD_PROFILE)
!             SECANT OF ZENITH ANGLE
!
!
!     COEFFICIENTS IN THE TWO-STREAM EQUATIONS:
      REAL*8	!, INTENT(OUT)
     &     TRANS_CLOUD(NPD_PROFILE, NPD_LAYER)
!             MEAN DIFFUSE TRANSMISSION COEFFICIENT
     &   , REFLECT_CLOUD(NPD_PROFILE, NPD_LAYER)
!             MEAN DIFFUSE REFLECTION COEFFICIENT
     &   , TRANS_0_CLOUD(NPD_PROFILE, NPD_LAYER)
!             MEAN DIRECT TRANSMISSION COEFFICIENT
     &   , SOURCE_COEFF_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)
!             MEAN SOURCE COEFFICIENTS IN TWO-STREAM EQUATIONS
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
!
!     COEFFICIENTS IN THE TWO-STREAM EQUATIONS:
      REAL*8	!, INTENT(OUT)
     &     TRANS_TEMP(NPD_PROFILE, NPD_LAYER)
!             TEMPORARY DIFFUSE TRANSMISSION COEFFICIENT
     &   , REFLECT_TEMP(NPD_PROFILE, NPD_LAYER)
!             TEMPORARY DIFFUSE REFLECTION COEFFICIENT
     &   , TRANS_0_TEMP(NPD_PROFILE, NPD_LAYER)
!             TEMPORARY DIRECT TRANSMISSION COEFFICIENT
     &   , SOURCE_COEFF_TEMP(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)
!             TEMPORARY SOURCE COEFFICIENTS IN TWO-STREAM EQUATIONS
!
!     VARIABLES FOR GATHERING:
      INTEGER
     &     N_LIST
!             NUMBER OF POINTS IN LIST
     &   , L_LIST(NPD_PROFILE)
!             LIST OF COLLECTED POINTS
     &   , LL
!             LOOP VARIABLE
      REAL*8
     &     TARGET
!             TARGET FOR SEARCHING
      REAL*8
     &     TAU_GATHERED(NPD_PROFILE, NPD_LAYER)
!             GATHERED OPTICAL DEPTH
     &   , OMEGA_GATHERED(NPD_PROFILE, NPD_LAYER)
!             GATHERED ALEBDO OF SINGLE SCATTERING
     &   , ASYMMETRY_GATHERED(NPD_PROFILE, NPD_LAYER)
!             GATHERED ASYMMETRY
     &   , SEC_0_GATHERED(NPD_PROFILE)
!             GATHERED ASYMMETRY
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     TWO_COEFF, WHENFGT
!
!     CRAY DIRECTIVES FOR THE WHOLE ROUTINE:
!     POINTS ARE NOT REPEATED IN THE INDEXING ARRAY, SO IT IS SAFE
!     TO VECTORIZE OVER INDIRECTLY ADDRESSED ARRAYS.
Cfpp$ NODEPCHK R
!
!
!
!     INITIALIZE THE FULL ARRAYS.
!
      DO I=I_LAYER_FIRST, I_LAYER_LAST
         DO L=1, N_PROFILE
            TRANS_CLOUD(L, I)=0.0D+00
            REFLECT_CLOUD(L, I)=0.0D+00
         ENDDO
      ENDDO
      DO J=1, N_SOURCE_COEFF
         DO I=I_LAYER_FIRST, I_LAYER_LAST
            DO L=1, N_PROFILE
               SOURCE_COEFF_CLOUD(L, I, J)=0.0D+00
            ENDDO
         ENDDO
      ENDDO
!
      IF (ISOLIR.EQ.IP_SOLAR) THEN
         DO I=I_LAYER_FIRST, I_LAYER_LAST
            DO L=1, N_PROFILE
               TRANS_0_CLOUD(L, I)=0.0D+00
            ENDDO
         ENDDO
      ENDIF
!
!
!     CALCULATE THE TRANSMISSION AND REFLECTION COEFFICIENTS FOR 
!     EACH TYPE OF CLOUD AND INCREMENT THE TOTALS, WEIGHTING WITH
!     THE CLOUD FRACTION.
!
      DO K=1, N_CLOUD_TYPE
!
!        GATHER POINTS WHERE THERE IS CLOUD OF THE PRESENT TYPE.
         TARGET=0.0D+00
!
         DO I=I_LAYER_FIRST, I_LAYER_LAST
!
!           DETERMINE WHETHER THIS TYPE OF CLOUD EXISTS IN THIS ROW.
            CALL WHENFGT(N_PROFILE, FRAC_CLOUD(1, I, K), 1
     &         , TARGET, L_LIST, N_LIST)
!
!
            IF (N_LIST.GT.0) THEN
!
!              GATHER THE OPTICAL PROPERTIES. THOUGH WE CONSIDER ONLY
!              ONE LAYER AT A TIME THE LOWER ROUTINES WILL OPERATE ON
!              ARRAYS WITH VERTICAL STRUCTURE, SO THE GATHERED ARRAYS
!              ARE TWO-DIMENSIONAL.
!
               DO L=1, N_LIST
                  TAU_GATHERED(L, I)
     &              =TAU_CLOUD(L_LIST(L), I, K)
                  OMEGA_GATHERED(L, I)
     &              =OMEGA_CLOUD(L_LIST(L), I, K)
                  ASYMMETRY_GATHERED(L, I)
     &              =ASYMMETRY_CLOUD(L_LIST(L), I, K)
               ENDDO
               IF (ISOLIR.EQ.IP_SOLAR) THEN
                  DO L=1, N_LIST
                     SEC_0_GATHERED(L)=SEC_0(L_LIST(L))
                  ENDDO
               ENDIF
!
!
               CALL TWO_COEFF(IERR
     &            , N_LIST, I, I
     &            , I_2STREAM, L_IR_SOURCE_QUAD
     &            , ASYMMETRY_GATHERED, OMEGA_GATHERED
     &            , TAU_GATHERED
     &            , ISOLIR, SEC_0_GATHERED
     &            , TRANS_TEMP, REFLECT_TEMP, TRANS_0_TEMP
     &            , SOURCE_COEFF_TEMP
     &            )
               IF (IERR.NE.I_NORMAL) RETURN
!
               DO L=1, N_LIST
                  LL=L_LIST(L)
                  TRANS_CLOUD(LL, I)=TRANS_CLOUD(LL, I)
     &               +FRAC_CLOUD(LL, I, K)*TRANS_TEMP(L, I)
                  REFLECT_CLOUD(LL, I)=REFLECT_CLOUD(LL, I)
     &               +FRAC_CLOUD(LL, I, K)*REFLECT_TEMP(L, I)
               ENDDO
               DO J=1, N_SOURCE_COEFF
                  DO L=1, N_LIST
                     LL=L_LIST(L)
                     SOURCE_COEFF_CLOUD(LL, I, J)
     &                  =SOURCE_COEFF_CLOUD(LL, I, J)
     &                  +FRAC_CLOUD(LL, I, K)*SOURCE_COEFF_TEMP(L, I, J)
                  ENDDO
               ENDDO
               IF (ISOLIR.EQ.IP_SOLAR) THEN
                  DO L=1, N_LIST
                     LL=L_LIST(L)
                     TRANS_0_CLOUD(LL, I)=TRANS_0_CLOUD(LL, I)
     &                  +FRAC_CLOUD(LL, I, K)*TRANS_0_TEMP(L, I)
                  ENDDO
               ENDIF
            ENDIF
!
         ENDDO
      ENDDO
!
!
!
      RETURN
      END
