C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.21065 
C                                                                                  RAD_ALL.21066 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.21067 
C restrictions as set forth in the contract.                                       RAD_ALL.21068 
C                                                                                  RAD_ALL.21069 
C                Meteorological Office                                             RAD_ALL.21070 
C                London Road                                                       RAD_ALL.21071 
C                BRACKNELL                                                         RAD_ALL.21072 
C                Berkshire UK                                                      RAD_ALL.21073 
C                RG12 2SZ                                                          RAD_ALL.21074 
C                                                                                  RAD_ALL.21075 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.21076 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.21077 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.21078 
C Modelling at the above address.                                                  RAD_ALL.21079 
C ******************************COPYRIGHT******************************            RAD_ALL.21080 
C                                                                                  RAD_ALL.21081 
!+ Subroutine to calculate the solar flux and source terms.                        RAD_ALL.21082 
!                                                                                  RAD_ALL.21083 
! Method:                                                                          RAD_ALL.21084 
!       Straightforward.                                                           RAD_ALL.21085 
!                                                                                  RAD_ALL.21086 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.21087 
!                                                                                  RAD_ALL.21088 
! History:                                                                         RAD_ALL.21089 
!       Version         Date                    Comment                            RAD_ALL.21090 
!       4.0             27-07-95                Original Code                      RAD_ALL.21091 
!                                               (J. M. Edwards)                    RAD_ALL.21092 
!       4.1             08-05-97                Formulation for                    RAD_ALL.21093 
!                                               equivalent extinction              RAD_ALL.21094 
!                                               amended.                           RAD_ALL.21095 
!                                                                                  RAD_ALL.21096 
! Description of Code:                                                             RAD_ALL.21097 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.21098 
!                                                                                  RAD_ALL.21099 
!- ---------------------------------------------------------------------           RAD_ALL.21100 
      SUBROUTINE SOLAR_SOURCE(N_PROFILE, N_LAYER                                   RAD_ALL.21101 
     &   , FLUX_INC_DIRECT                                                         RAD_ALL.21102 
     &   , TRANS_0, SOURCE_COEFF                                                   RAD_ALL.21103 
     &   , L_SCALE_SOLAR, ADJUST_SOLAR_KE                                          RAD_ALL.21104 
     &   , FLUX_DIRECT                                                             RAD_ALL.21105 
     &   , S_DOWN, S_UP                                                            RAD_ALL.21106 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.21107 
     &   )                                                                         RAD_ALL.21108 
!                                                                                  RAD_ALL.21109 
!                                                                                  RAD_ALL.21110 
      IMPLICIT NONE                                                                RAD_ALL.21111 
!                                                                                  RAD_ALL.21112 
!                                                                                  RAD_ALL.21113 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.21114 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.21115 
     &     NPD_PROFILE                                                             RAD_ALL.21116 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.21117 
     &   , NPD_LAYER                                                               RAD_ALL.21118 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.21119 
!                                                                                  RAD_ALL.21120 
!     COMDECKS INCLUDED.                                                           RAD_ALL.21121 
!     ------------------------------------------------------------------           DIMFIX3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       DIMFIX3A.3     
!                                                                                  DIMFIX3A.4     
!     MODULE TO SET INTERNAL DIMENSIONS TIED TO ALGORITHMS,                        DIMFIX3A.5     
!     MOSTLY FOR CLOUDS.                                                           DIMFIX3A.6     
!                                                                                  DIMFIX3A.7     
      INTEGER                                                                      DIMFIX3A.8     
     &     NPD_CLOUD_COMPONENT                                                     DIMFIX3A.9     
!             NUMBER OF COMPONENTS OF CLOUDS                                       DIMFIX3A.10    
     &   , NPD_CLOUD_TYPE                                                          DIMFIX3A.11    
!             NUMBER OF PERMITTED TYPES OF CLOUDS.                                 DIMFIX3A.12    
     &   , NPD_CLOUD_REPRESENTATION                                                DIMFIX3A.13    
!             NUMBER OF PERMITTED REPRESENTATIONS OF CLOUDS.                       DIMFIX3A.14    
     &   , NPD_OVERLAP_COEFF                                                       DIMFIX3A.15    
!             NUMBER OF OVERLAP COEFFICIENTS FOR CLOUDS                            DIMFIX3A.16    
     &   , NPD_SOURCE_COEFF                                                        DIMFIX3A.17    
!             NUMBER OF COEFFICIENTS FOR TWO-STREAM SOURCES                        DIMFIX3A.18    
     &   , NPD_REGION                                                              DIMFIX3A.19    
!             NUMBER OF REGIONS IN A LAYER                                         DIMFIX3A.20    
!                                                                                  DIMFIX3A.21    
      PARAMETER(                                                                   DIMFIX3A.22    
     &     NPD_CLOUD_COMPONENT=4                                                   DIMFIX3A.23    
     &   , NPD_CLOUD_TYPE=4                                                        DIMFIX3A.24    
     &   , NPD_CLOUD_REPRESENTATION=4                                              DIMFIX3A.25    
     &   , NPD_OVERLAP_COEFF=18                                                    DIMFIX3A.26    
     &   , NPD_SOURCE_COEFF=2                                                      DIMFIX3A.27    
     &   , NPD_REGION=3                                                            DIMFIX3A.28    
     &   )                                                                         DIMFIX3A.29    
!                                                                                  DIMFIX3A.30    
!     ------------------------------------------------------------------           DIMFIX3A.31    
!     ------------------------------------------------------------------           SCFPT3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       SCFPT3A.3     
!                                                                                  SCFPT3A.4     
!     MODULE TO SET POINTERS TO SOURCE COEFFICIENTS.                               SCFPT3A.5     
!                                                                                  SCFPT3A.6     
      INTEGER                                                                      SCFPT3A.7     
     &     IP_SCF_SOLAR_UP                                                         SCFPT3A.8     
!             POINTER TO SOURCE COEFICIENT FOR UPWARD SOLAR BEAM                   SCFPT3A.9     
     &   , IP_SCF_SOLAR_DOWN                                                       SCFPT3A.10    
!             POINTER TO SOURCE COEFICIENT FOR DOWNWARD SOLAR BEAM                 SCFPT3A.11    
     &   , IP_SCF_IR_1D                                                            SCFPT3A.12    
!             POINTER TO SOURCE COEFICIENT                                         SCFPT3A.13    
!             FOR 1ST DIFFERENCE OF PLANCKIAN                                      SCFPT3A.14    
     &   , IP_SCF_IR_2D                                                            SCFPT3A.15    
!             POINTER TO SOURCE COEFICIENT                                         SCFPT3A.16    
!             FOR 2ND DIFFERENCE OF PLANCKIAN                                      SCFPT3A.17    
!                                                                                  SCFPT3A.18    
      PARAMETER(                                                                   SCFPT3A.19    
     &     IP_SCF_SOLAR_UP=1                                                       SCFPT3A.20    
     &   , IP_SCF_SOLAR_DOWN=2                                                     SCFPT3A.21    
     &   , IP_SCF_IR_1D=1                                                          SCFPT3A.22    
     &   , IP_SCF_IR_2D=2                                                          SCFPT3A.23    
     &   )                                                                         SCFPT3A.24    
!                                                                                  SCFPT3A.25    
!     ------------------------------------------------------------------           SCFPT3A.26    
!                                                                                  RAD_ALL.21124 
!     DUMMY VARIABLES.                                                             RAD_ALL.21125 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.21126 
     &     N_PROFILE                                                               RAD_ALL.21127 
!             NUMBER OF PROFILES                                                   RAD_ALL.21128 
     &   , N_LAYER                                                                 RAD_ALL.21129 
!             NUMBER OF LAYERS                                                     RAD_ALL.21130 
!                                                                                  RAD_ALL.21131 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.21132 
     &     L_SCALE_SOLAR                                                           RAD_ALL.21133 
!             SCALING APPLIED TO SOLAR BEAM                                        RAD_ALL.21134 
!                                                                                  RAD_ALL.21135 
      REAL      !, INTENT(IN)                                                      RAD_ALL.21136 
     &     FLUX_INC_DIRECT(NPD_PROFILE)                                            RAD_ALL.21137 
!             INCIDENT SOLAR FLUX                                                  RAD_ALL.21138 
     &   , TRANS_0(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.21139 
!             DIRECT TRANSMISSION COEFFICIENT                                      RAD_ALL.21140 
     &   , SOURCE_COEFF(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)                  RAD_ALL.21141 
!             REFLECTION COEFFICIENT                                               RAD_ALL.21142 
     &   , ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.21143 
!             ADJUSTMENT TO SOLAR FLUX                                             RAD_ALL.21144 
!                                                                                  RAD_ALL.21145 
!                                                                                  RAD_ALL.21146 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.21147 
     &     FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER)                                  RAD_ALL.21148 
!             DIRECT FLUX                                                          RAD_ALL.21149 
     &   , S_DOWN(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.21150 
!             DOWNWARD SOURCE FUNCTION                                             RAD_ALL.21151 
     &   , S_UP(NPD_PROFILE, NPD_LAYER)                                            RAD_ALL.21152 
!             UPWARD SOURCE FUNCTION                                               RAD_ALL.21153 
!                                                                                  RAD_ALL.21154 
!                                                                                  RAD_ALL.21155 
!     LOCAL VARIABLES.                                                             RAD_ALL.21156 
      INTEGER                                                                      RAD_ALL.21157 
     &     I                                                                       RAD_ALL.21158 
!             LOOP VARIABLE                                                        RAD_ALL.21159 
     &   , L                                                                       RAD_ALL.21160 
!             LOOP VARIABLE                                                        RAD_ALL.21161 
!                                                                                  RAD_ALL.21162 
!                                                                                  RAD_ALL.21163 
!                                                                                  RAD_ALL.21164 
      DO L=1, N_PROFILE                                                            RAD_ALL.21165 
         FLUX_DIRECT(L, 0)=FLUX_INC_DIRECT(L)                                      RAD_ALL.21166 
      ENDDO                                                                        RAD_ALL.21167 
!                                                                                  RAD_ALL.21168 
!     THE SOLAR FLUX MAY BE MULTIPLIED BY A SCALING FACTOR IF AN                   RAD_ALL.21169 
!     EQUIVALENT EXTINCTION IS USED.                                               RAD_ALL.21170 
!                                                                                  RAD_ALL.21171 
      IF (L_SCALE_SOLAR) THEN                                                      RAD_ALL.21172 
!                                                                                  RAD_ALL.21173 
         DO I=1, N_LAYER                                                           RAD_ALL.21174 
            DO L=1, N_PROFILE                                                      RAD_ALL.21175 
               FLUX_DIRECT(L, I)                                                   RAD_ALL.21176 
     &            =FLUX_DIRECT(L, I-1)*TRANS_0(L, I)                               RAD_ALL.21177 
     &            *ADJUST_SOLAR_KE(L, I)                                           RAD_ALL.21178 
               S_UP(L, I)=SOURCE_COEFF(L, I, IP_SCF_SOLAR_UP)                      RAD_ALL.21179 
     &            *FLUX_DIRECT(L, I-1)                                             RAD_ALL.21180 
               S_DOWN(L, I)=(SOURCE_COEFF(L, I, IP_SCF_SOLAR_DOWN)                 RAD_ALL.21181 
     &            -TRANS_0(L, I))*FLUX_DIRECT(L, I-1)                              RAD_ALL.21182 
     &            +FLUX_DIRECT(L, I)                                               RAD_ALL.21183 
            ENDDO                                                                  RAD_ALL.21184 
         ENDDO                                                                     RAD_ALL.21185 
!                                                                                  RAD_ALL.21186 
      ELSE                                                                         RAD_ALL.21187 
!                                                                                  RAD_ALL.21188 
         DO I=1, N_LAYER                                                           RAD_ALL.21189 
            DO L=1, N_PROFILE                                                      RAD_ALL.21190 
               FLUX_DIRECT(L, I)                                                   RAD_ALL.21191 
     &            =FLUX_DIRECT(L, I-1)*TRANS_0(L, I)                               RAD_ALL.21192 
               S_UP(L, I)=SOURCE_COEFF(L, I, IP_SCF_SOLAR_UP)                      RAD_ALL.21193 
     &            *FLUX_DIRECT(L, I-1)                                             RAD_ALL.21194 
               S_DOWN(L, I)=SOURCE_COEFF(L, I, IP_SCF_SOLAR_DOWN)                  RAD_ALL.21195 
     &            *FLUX_DIRECT(L, I-1)                                             RAD_ALL.21196 
            ENDDO                                                                  RAD_ALL.21197 
         ENDDO                                                                     RAD_ALL.21198 
!                                                                                  RAD_ALL.21199 
      ENDIF                                                                        RAD_ALL.21200 
!                                                                                  RAD_ALL.21201 
!                                                                                  RAD_ALL.21202 
      RETURN                                                                       RAD_ALL.21203 
      END  
