C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.499   
C                                                                                  RAD_ALL.500   
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.501   
C restrictions as set forth in the contract.                                       RAD_ALL.502   
C                                                                                  RAD_ALL.503   
C                Meteorological Office                                             RAD_ALL.504   
C                London Road                                                       RAD_ALL.505   
C                BRACKNELL                                                         RAD_ALL.506   
C                Berkshire UK                                                      RAD_ALL.507   
C                RG12 2SZ                                                          RAD_ALL.508   
C                                                                                  RAD_ALL.509   
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.510   
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.511   
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.512   
C Modelling at the above address.                                                  RAD_ALL.513   
C ******************************COPYRIGHT******************************            RAD_ALL.514   
C                                                                                  RAD_ALL.515   
!+ Subroutine to assign fluxes to the final arrays.                                RAD_ALL.516   
!                                                                                  RAD_ALL.517   
! Method:                                                                          RAD_ALL.518   
!       The array FLUX_TOTAL holds the calculated total fluxes                     RAD_ALL.519   
!       (differential fluxes in the IR). These may be net or                       RAD_ALL.520   
!       upward and downward fluxes. Upward and downward fluxes                     RAD_ALL.521   
!       are passed to FLUX_UP and FLUX_DOWN and incremented by the                 RAD_ALL.522   
!       Planckian flux in the IR. Net downward fluxes are assigned                 RAD_ALL.523   
!       to FLUX_DOWN. Equivalent calculations may be performed for                 RAD_ALL.524   
!       the clear-sky fluxes.                                                      RAD_ALL.525   
!                                                                                  RAD_ALL.526   
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.527   
!                                                                                  RAD_ALL.528   
! History:                                                                         RAD_ALL.529   
!       Version         Date                    Comment                            RAD_ALL.530   
!       4.0             27-07-95                Original Code                      RAD_ALL.531   
!                                               (J. M. Edwards)                    RAD_ALL.532   
!                                                                                  RAD_ALL.533   
! Description of Code:                                                             RAD_ALL.534   
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.535   
!                                                                                  RAD_ALL.536   
!- ---------------------------------------------------------------------           RAD_ALL.537   
      SUBROUTINE ASSIGN_FLUX(N_PROFILE, N_LAYER                                    RAD_ALL.538   
     &   , FLUX_TOTAL, FLUX_TOTAL_CLEAR                                            RAD_ALL.539   
     &   , ISOLIR                                                                  RAD_ALL.540   
     &   , PLANCK_FLUX                                                             RAD_ALL.541   
     &   , L_CLEAR, L_NET                                                          RAD_ALL.542   
     &   , FLUX_DOWN, FLUX_UP, FLUX_DOWN_CLEAR, FLUX_UP_CLEAR                      RAD_ALL.543   
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.544   
     &   )                                                                         RAD_ALL.545   
!                                                                                  RAD_ALL.546   
!                                                                                  RAD_ALL.547   
      IMPLICIT NONE                                                                RAD_ALL.548   
!                                                                                  RAD_ALL.549   
!                                                                                  RAD_ALL.550   
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.551   
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.552   
     &     NPD_PROFILE                                                             RAD_ALL.553   
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.554   
     &   , NPD_LAYER                                                               RAD_ALL.555   
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.556   
!                                                                                  RAD_ALL.557   
!                                                                                  RAD_ALL.558   
!     INCLUDE COMDECKS.                                                            RAD_ALL.559   
!     ------------------------------------------------------------------           SPCRG3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       SPCRG3A.3     
!                                                                                  SPCRG3A.4     
!     MODULE TO SET FLAGS FOR DIFFERENT PORTIONS                                   SPCRG3A.5     
!     OF THE SPECTRUM.                                                             SPCRG3A.6     
!                                                                                  SPCRG3A.7     
      INTEGER                                                                      SPCRG3A.8     
     &     IP_SOLAR                                                                SPCRG3A.9     
!             SOLAR REGION                                                         SPCRG3A.10    
     &   , IP_INFRA_RED                                                            SPCRG3A.11    
!             INFRA-RED REGION                                                     SPCRG3A.12    
!                                                                                  SPCRG3A.13    
      PARAMETER(                                                                   SPCRG3A.14    
     &     IP_SOLAR=1                                                              SPCRG3A.15    
     &   , IP_INFRA_RED=2                                                          SPCRG3A.16    
     &   )                                                                         SPCRG3A.17    
!                                                                                  SPCRG3A.18    
!     ------------------------------------------------------------------           SPCRG3A.19    
!                                                                                  RAD_ALL.561   
!     DUMMY ARGUMENTS.                                                             RAD_ALL.562   
      INTEGER                                                                      RAD_ALL.563   
     &     N_PROFILE                                                               RAD_ALL.564   
!             NUMBER OF PROFILES                                                   RAD_ALL.565   
     &   , N_LAYER                                                                 RAD_ALL.566   
!             NUMBER OF LAYERS                                                     RAD_ALL.567   
     &   , ISOLIR                                                                  RAD_ALL.568   
!             SPECTRAL REGION                                                      RAD_ALL.569   
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.570   
     &     L_CLEAR                                                                 RAD_ALL.571   
!             CLEAR FLUX FLAG                                                      RAD_ALL.572   
     &   , L_NET                                                                   RAD_ALL.573   
!             CALCULATE NET FLUXES                                                 RAD_ALL.574   
      REAL      !, INTENT(IN)                                                      RAD_ALL.575   
     &     FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2)                                  RAD_ALL.576   
!             LONG VECTOR OF TOTAL FLUXES                                          RAD_ALL.577   
     &   , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2)                            RAD_ALL.578   
!             LONG VECTOR OF TOTAL CLEAR FLUXES                                    RAD_ALL.579   
     &   , PLANCK_FLUX(NPD_PROFILE, 0: NPD_LAYER)                                  RAD_ALL.580   
!             PLANCKIAN FLUXES AT BOUNDARIES                                       RAD_ALL.581   
      REAL      !, INTENT(OUT)                                                     RAD_ALL.582   
     &     FLUX_DOWN(NPD_PROFILE, 0: NPD_LAYER)                                    RAD_ALL.583   
!             (NET) TOTAL DOWNWARD FLUXES                                          RAD_ALL.584   
     &   , FLUX_UP(NPD_PROFILE, 0: NPD_LAYER)                                      RAD_ALL.585   
!             UPWARD FLUXES                                                        RAD_ALL.586   
     &   , FLUX_DOWN_CLEAR(NPD_PROFILE, 0: NPD_LAYER)                              RAD_ALL.587   
!             CLEAR (NET) TOTAL DOWNWARD FLUXES                                    RAD_ALL.588   
     &   , FLUX_UP_CLEAR(NPD_PROFILE, 0: NPD_LAYER)                                RAD_ALL.589   
!             CLEAR UPWARD FLUXES                                                  RAD_ALL.590   
                                                                                   RAD_ALL.591   
!     LOCAL VARIABLES.                                                             RAD_ALL.592   
      INTEGER                                                                      RAD_ALL.593   
     &     I                                                                       RAD_ALL.594   
!             LOOP VARIABLE                                                        RAD_ALL.595   
     &   , L                                                                       RAD_ALL.596   
!             LOOP VARIABLE                                                        RAD_ALL.597   
!                                                                                  RAD_ALL.598   
!                                                                                  RAD_ALL.599   
      IF (ISOLIR.EQ.IP_SOLAR) THEN                                                 RAD_ALL.600   
         IF (L_NET) THEN                                                           RAD_ALL.601   
            DO I=0, N_LAYER                                                        RAD_ALL.602   
               DO L=1, N_PROFILE                                                   RAD_ALL.603   
                  FLUX_DOWN(L, I)=FLUX_TOTAL(L, I+1)                               RAD_ALL.604   
               ENDDO                                                               RAD_ALL.605   
            ENDDO                                                                  RAD_ALL.606   
         ELSE                                                                      RAD_ALL.607   
            DO I=0, N_LAYER                                                        RAD_ALL.608   
               DO L=1, N_PROFILE                                                   RAD_ALL.609   
                  FLUX_UP(L, I)=FLUX_TOTAL(L, 2*I+1)                               RAD_ALL.610   
                  FLUX_DOWN(L, I)=FLUX_TOTAL(L, 2*I+2)                             RAD_ALL.611   
               ENDDO                                                               RAD_ALL.612   
            ENDDO                                                                  RAD_ALL.613   
         ENDIF                                                                     RAD_ALL.614   
      ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                        RAD_ALL.615   
         IF (L_NET) THEN                                                           RAD_ALL.616   
!           NO PLANCKIAN CORRECTION IS NECESSARY TO THE NET FLUX.                  RAD_ALL.617   
            DO I=0, N_LAYER                                                        RAD_ALL.618   
               DO L=1, N_PROFILE                                                   RAD_ALL.619   
                  FLUX_DOWN(L, I)=FLUX_TOTAL(L, I+1)                               RAD_ALL.620   
               ENDDO                                                               RAD_ALL.621   
            ENDDO                                                                  RAD_ALL.622   
         ELSE                                                                      RAD_ALL.623   
            DO I=0, N_LAYER                                                        RAD_ALL.624   
               DO L=1, N_PROFILE                                                   RAD_ALL.625   
                  FLUX_UP(L, I)=FLUX_TOTAL(L, 2*I+1)                               RAD_ALL.626   
     &               +PLANCK_FLUX(L, I)                                            RAD_ALL.627   
                  FLUX_DOWN(L, I)=FLUX_TOTAL(L, 2*I+2)                             RAD_ALL.628   
     &               +PLANCK_FLUX(L, I)                                            RAD_ALL.629   
               ENDDO                                                               RAD_ALL.630   
            ENDDO                                                                  RAD_ALL.631   
         ENDIF                                                                     RAD_ALL.632   
      ENDIF                                                                        RAD_ALL.633   
!                                                                                  RAD_ALL.634   
      IF (L_CLEAR) THEN                                                            RAD_ALL.635   
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                              RAD_ALL.636   
            IF (L_NET) THEN                                                        RAD_ALL.637   
               DO I=0, N_LAYER                                                     RAD_ALL.638   
                  DO L=1, N_PROFILE                                                RAD_ALL.639   
                     FLUX_DOWN_CLEAR(L, I)=FLUX_TOTAL_CLEAR(L, I+1)                RAD_ALL.640   
                  ENDDO                                                            RAD_ALL.641   
               ENDDO                                                               RAD_ALL.642   
            ELSE                                                                   RAD_ALL.643   
               DO I=0, N_LAYER                                                     RAD_ALL.644   
                  DO L=1, N_PROFILE                                                RAD_ALL.645   
                     FLUX_UP_CLEAR(L, I)=FLUX_TOTAL_CLEAR(L, 2*I+1)                RAD_ALL.646   
                     FLUX_DOWN_CLEAR(L, I)=FLUX_TOTAL_CLEAR(L, 2*I+2)              RAD_ALL.647   
                  ENDDO                                                            RAD_ALL.648   
               ENDDO                                                               RAD_ALL.649   
            ENDIF                                                                  RAD_ALL.650   
!                                                                                  RAD_ALL.651   
         ELSEIF (ISOLIR.EQ.IP_INFRA_RED) THEN                                      RAD_ALL.652   
            IF (L_NET) THEN                                                        RAD_ALL.653   
               DO I=0, N_LAYER                                                     RAD_ALL.654   
                  DO L=1, N_PROFILE                                                RAD_ALL.655   
                     FLUX_DOWN_CLEAR(L, I)=FLUX_TOTAL_CLEAR(L, I+1)                RAD_ALL.656   
                  ENDDO                                                            RAD_ALL.657   
               ENDDO                                                               RAD_ALL.658   
            ELSE                                                                   RAD_ALL.659   
               DO I=0, N_LAYER                                                     RAD_ALL.660   
                  DO L=1, N_PROFILE                                                RAD_ALL.661   
                     FLUX_UP_CLEAR(L, I)=FLUX_TOTAL_CLEAR(L, 2*I+1)                RAD_ALL.662   
     &                  +PLANCK_FLUX(L, I)                                         RAD_ALL.663   
                     FLUX_DOWN_CLEAR(L, I)=FLUX_TOTAL_CLEAR(L, 2*I+2)              RAD_ALL.664   
     &                  +PLANCK_FLUX(L, I)                                         RAD_ALL.665   
                  ENDDO                                                            RAD_ALL.666   
               ENDDO                                                               RAD_ALL.667   
            ENDIF                                                                  RAD_ALL.668   
         ENDIF                                                                     RAD_ALL.669   
      ENDIF                                                                        RAD_ALL.670   
!                                                                                  RAD_ALL.671   
!     NET FLUXES ARE HABITUALLY USED IN THE UNIFIED MODEL, SO THE                  RAD_ALL.672   
!     FOLLOWING REDUCTION IS ALWAYS CARRIED OUT.                                   RAD_ALL.673   
      IF (.NOT.L_NET) THEN                                                         RAD_ALL.674   
         DO I=0, N_LAYER                                                           RAD_ALL.675   
            DO L=1, N_PROFILE                                                      RAD_ALL.676   
               FLUX_DOWN(L, I)=FLUX_DOWN(L, I)-FLUX_UP(L, I)                       RAD_ALL.677   
            ENDDO                                                                  RAD_ALL.678   
         ENDDO                                                                     RAD_ALL.679   
         IF (L_CLEAR) THEN                                                         RAD_ALL.680   
            DO I=0, N_LAYER                                                        RAD_ALL.681   
               DO L=1, N_PROFILE                                                   RAD_ALL.682   
                  FLUX_DOWN_CLEAR(L, I)                                            RAD_ALL.683   
     &               =FLUX_DOWN_CLEAR(L, I)-FLUX_UP_CLEAR(L, I)                    RAD_ALL.684   
               ENDDO                                                               RAD_ALL.685   
            ENDDO                                                                  RAD_ALL.686   
         ENDIF                                                                     RAD_ALL.687   
      ENDIF                                                                        RAD_ALL.688   
!                                                                                  RAD_ALL.689   
!                                                                                  RAD_ALL.690   
      RETURN                                                                       RAD_ALL.691   
      END             
