!+ Subroutine to calculate the basic coefficients for the solar beam.
!
! Method:
!	Straightforward.
!
! 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 SOLAR_COEFFICIENT_BASIC(IERR
     &   , N_PROFILE, I_LAYER_FIRST, I_LAYER_LAST
     &   , OMEGA, ASYMMETRY, SEC_0
     &   , I_2STREAM
     &   , SUM, DIFF, LAMBDA
     &   , GAMMA_UP, GAMMA_DOWN
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/two_stream_scheme.pcf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/error.pcf'
!
!
!     DUMMY VARIABLES.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_PROFILE
!             NUMBER OF PROFILES
     &   , I_LAYER_FIRST
!             FIRST LAYER TO CONSIDER
     &   , I_LAYER_LAST
!             FIRST LAYER TO CONSIDER
     &   , I_2STREAM
!             TWO-STREAM SCHEME
!
      REAL*8	!, INTENT(IN)
     &     OMEGA(NPD_PROFILE, NPD_LAYER)
!             ALBEDO OF SINGLE SCATTERING
     &   , ASYMMETRY(NPD_PROFILE, NPD_LAYER)
!             ASYMMETRY
     &   , SEC_0(NPD_PROFILE)
!             SECANT OF SOLAR ZENITH ANGLE
     &   , SUM(NPD_PROFILE, NPD_LAYER)
!             SUM OF TWO-STREAM COEFFICIENTS
     &   , DIFF(NPD_PROFILE, NPD_LAYER)
!             DIFFERENCE OF TWO-STREAM COEFFICIENTS
     &   , LAMBDA(NPD_PROFILE, NPD_LAYER)
!             LAMBDA
!
!     BASIC TWO-STREAM COEFFICIENTS:
      REAL*8	!, INTENT(OUT)
     &     GAMMA_UP(NPD_PROFILE, NPD_LAYER)
!             COEFFICIENT FOR UPWARD RADIATION
     &   , GAMMA_DOWN(NPD_PROFILE, NPD_LAYER)
!             COEFFICIENT FOR DOWNWAD RADIATION
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , KK
!             TEMPORARY VARIABLE
     &   , N_INDEX
!             NUMBER OF INDICES SATISFYING TEST
     &   , INDEX(NPD_PROFILE)
!             INDICES OF TESTED POINTS
      REAL*8
     &     KSI_0(NPD_PROFILE, NPD_LAYER)
!             DIFFERENCE IN SOLAR SCATTERING FRACTIONS
     &   , TEST_ARRAY(NPD_PROFILE)
!             ARRAY TO TEST
     &   , FACTOR
!             TEMPORARY VARIABLE
      REAL*8
     &     ROOT_3
!             SQUARE ROOT OF 3
      PARAMETER(
     &     ROOT_3=1.7320508075688772D+00
     &   )
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     WHENFLT
!
!     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
!
!
!
!     IF LAMBDA IS TOO CLOSE TO SEC_0 IT MUST BE PERTURBED
      DO I=I_LAYER_FIRST, I_LAYER_LAST
         DO L=1, N_PROFILE
            TEST_ARRAY(L)=ABS(LAMBDA(L, I)-SEC_0(L))
         ENDDO
         CALL WHENFLT(N_PROFILE, TEST_ARRAY, 1, TOL_DIV, INDEX
     &      , N_INDEX)
         DO K=1, N_INDEX
            KK=INDEX(K)
            SUM(KK, I)=(1.0D+00+TOL_DIV)*SUM(KK, I)
            DIFF(KK, I)=(1.0D+00+TOL_DIV)*DIFF(KK, I)
            LAMBDA(KK, I)=(1.0D+00+TOL_DIV)*LAMBDA(KK, I)
         ENDDO
      ENDDO
!
      IF ( (I_2STREAM.EQ.IP_EDDINGTON).OR.
     &     (I_2STREAM.EQ.IP_ELSASSER).OR.
     &     (I_2STREAM.EQ.IP_PIFM85).OR.
     &     (I_2STREAM.EQ.IP_2S_TEST).OR.
     &     (I_2STREAM.EQ.IP_HEMI_MEAN).OR.
     &     (I_2STREAM.EQ.IP_PIFM80) ) THEN
!
          DO I=I_LAYER_FIRST, I_LAYER_LAST
             DO L=1, N_PROFILE
                KSI_0(L, I)=1.5D+00*ASYMMETRY(L, I)/SEC_0(L)
             ENDDO
          ENDDO
!
       ELSE IF (I_2STREAM.EQ.IP_DISCRETE_ORD) THEN
!
          DO I=I_LAYER_FIRST, I_LAYER_LAST
             DO L=1, N_PROFILE
                KSI_0(L, I)=ROOT_3*ASYMMETRY(L, I)/SEC_0(L)
             ENDDO
          ENDDO
!
       ELSE
!
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: AN ILLEGAL SOLAR TWO-STREAM SCHEME HAS '
     &      //'BEEN SELECTED.'
         IERR=I_ERR_FATAL
         RETURN
!
      ENDIF
!
!
!     DETERMINE THE BASIC SOLAR COEFFICIENTS FOR THE 
!     TWO-STREAM EQUATIONS.
!
      DO I=I_LAYER_FIRST, I_LAYER_LAST
         DO L=1, N_PROFILE
            FACTOR=0.5D+00*OMEGA(L, I)*SEC_0(L)
     &         /((LAMBDA(L, I)-SEC_0(L))*(LAMBDA(L, I)+SEC_0(L)))
            GAMMA_UP(L, I)=FACTOR*(SUM(L, I)-SEC_0(L)
     &         -KSI_0(L, I)*(DIFF(L, I)-SEC_0(L)))
            GAMMA_DOWN(L, I)=FACTOR*(SUM(L, I)+SEC_0(L)
     &         +KSI_0(L, I)*(DIFF(L, I)+SEC_0(L)))
         ENDDO
      ENDDO
!
!
!
      RETURN
      END
