!+ Subroutine to calculate spectral diagnostics and coupling arrays.               RAD_ALL.2397  
!                                                                                  RAD_ALL.2398  
! Purpose:                                                                         RAD_ALL.2399  
!   The coupling and diagnostic arrays are calculated.                             RAD_ALL.2400  
!                                                                                  RAD_ALL.2401  
! Method:                                                                          RAD_ALL.2402  
!   Straightforward.                                                               RAD_ALL.2403  
!                                                                                  RAD_ALL.2404  
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.2405  
!                                                                                  RAD_ALL.2406  
! History:                                                                         RAD_ALL.2407  
!       Version         Date                    Comment                            RAD_ALL.2408  
!       4.0             27-07-95                Original Code                      RAD_ALL.2409  
!                                               (J. M. Edwards)                    RAD_ALL.2410  
!       4.1             10-06-96                Formulation over                   RAD_ALL.2411  
!                                               sea-ice revised.                   RAD_ALL.2412  
!                                               Corrections to                     RAD_ALL.2413  
!                                               some diagnostics.                  RAD_ALL.2414  
!                                               (J. M. Edwards)                    RAD_ALL.2415  
!                                                                                  RAD_ALL.2416  
! Description of Code:                                                             RAD_ALL.2417  
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.2418  
!                                                                                  RAD_ALL.2419  
!- ---------------------------------------------------------------------           RAD_ALL.2420  
      SUBROUTINE R2_COUPLE_DIAG(N_PROFILE, L_NET, ISOLIR                           RAD_ALL.2421  
     &   , ALBEDO_FIELD_DIFF, ALBEDO_FIELD_DIR                                     RAD_ALL.2422  
     &   , ALBEDO_SEA_DIFF, ALBEDO_SEA_DIR                                         RAD_ALL.2423  
     &   , N_FRAC_ICE_POINT, I_FRAC_ICE_POINT, ICE_FRACTION                        RAD_ALL.2424  
     &   , PLANCK_FREEZE_SEA                                                       RAD_ALL.2425  
     &   , PLANCK_AIR_SURFACE, THERMAL_SOURCE_GROUND                               RAD_ALL.2426  
     &   , FLUX_DOWN, FLUX_UP, FLUX_DIRECT                                         RAD_ALL.2427  
     &   , FLUX_DOWN_CLEAR, FLUX_UP_CLEAR, FLUX_DIRECT_CLEAR                       RAD_ALL.2428  
     &   , WEIGHT_690NM                                                            RAD_ALL.2429  
     &   , SEA_FLUX                                                                RAD_ALL.2430  
     &   , L_SURFACE_DOWN_FLUX, SURFACE_DOWN_FLUX                                  RAD_ALL.2431  
     &   , L_SURF_DOWN_CLR, SURF_DOWN_CLR                                          RAD_ALL.2432  
     &   , L_SURF_UP_CLR, SURF_UP_CLR                                              RAD_ALL.2433  
     &   , L_FLUX_BELOW_690NM_SURF, FLUX_BELOW_690NM_SURF                          RAD_ALL.2434  
     &   , NPD_PROFILE                                                             RAD_ALL.2435  
     &   )                                                                         RAD_ALL.2436  
!                                                                                  RAD_ALL.2437  
!                                                                                  RAD_ALL.2438  
!                                                                                  RAD_ALL.2439  
      IMPLICIT NONE                                                                RAD_ALL.2440  
!                                                                                  RAD_ALL.2441  
!                                                                                  RAD_ALL.2442  
!     COMDECKS INCLUDED                                                            RAD_ALL.2443  
!     SPECTRAL REGIONS                                                             RAD_ALL.2444  
!     ------------------------------------------------------------------           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.2446  
!     DUMMY ARGUMENTS                                                              RAD_ALL.2447  
!                                                                                  RAD_ALL.2448  
!     DIMENSIONS OF ARRAYS                                                         RAD_ALL.2449  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.2450  
     &     NPD_PROFILE                                                             RAD_ALL.2451  
!             MAXIMUM NUMBER OF ATMOSPHERIC PROFILES                               RAD_ALL.2452  
!                                                                                  RAD_ALL.2453  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.2454  
     &     N_PROFILE                                                               RAD_ALL.2455  
!             NUMBER OF ATMOSPHERIC PROFILES                                       RAD_ALL.2456  
     &   , ISOLIR                                                                  RAD_ALL.2457  
!             SPECTRAL REGION                                                      RAD_ALL.2458  
!                                                                                  RAD_ALL.2459  
!     LOGICAL SWITCHES FOR THE CODE                                                RAD_ALL.2460  
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.2461  
     &     L_NET                                                                   RAD_ALL.2462  
!             FLAG FOR NET FLUXES                                                  RAD_ALL.2463  
!                                                                                  RAD_ALL.2464  
!     SWITCHES FOR DIAGNOSTICS:                                                    RAD_ALL.2465  
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.2466  
     &     L_FLUX_BELOW_690NM_SURF                                                 RAD_ALL.2467  
!             FLUX BELOW 690NM AT SURFACE TO BE CALCULATED                         RAD_ALL.2468  
     &   , L_SURFACE_DOWN_FLUX                                                     RAD_ALL.2469  
!             DOWNWARD SURFACE FLUX REQUIRED                                       RAD_ALL.2470  
     &   , L_SURF_DOWN_CLR                                                         RAD_ALL.2471  
!             CALCULATE DOWNWARD CLEAR FLUX                                        RAD_ALL.2472  
     &   , L_SURF_UP_CLR                                                           RAD_ALL.2473  
!             CALCULATE UPWARD CLEAR FLUX                                          RAD_ALL.2474  
!                                                                                  RAD_ALL.2475  
!     ALBEDOS                                                                      RAD_ALL.2476  
      REAL      !, INTENT(IN)                                                      RAD_ALL.2477  
     &     ALBEDO_FIELD_DIFF(NPD_PROFILE)                                          RAD_ALL.2478  
!             DIFFUSE ALBEDO MEANED OVER GRID BOX                                  RAD_ALL.2479  
     &   , ALBEDO_FIELD_DIR(NPD_PROFILE)                                           RAD_ALL.2480  
!             DIRECT ALBEDO MEANED OVER GRID BOX                                   RAD_ALL.2481  
     &   , ALBEDO_SEA_DIFF(NPD_PROFILE)                                            RAD_ALL.2482  
!             DIFFUSE ALBEDO OF OPEN SEA                                           RAD_ALL.2483  
     &   , ALBEDO_SEA_DIR(NPD_PROFILE)                                             RAD_ALL.2484  
!             DIRECT ALBEDO MEANED OF OPEN SEA                                     RAD_ALL.2485  
!                                                                                  RAD_ALL.2486  
      REAL      !, INTENT(IN)                                                      RAD_ALL.2487  
     &     THERMAL_SOURCE_GROUND(NPD_PROFILE)                                      RAD_ALL.2488  
!             THERMAL SOURCE AT GROUND                                             RAD_ALL.2489  
     &   , PLANCK_AIR_SURFACE(NPD_PROFILE)                                         RAD_ALL.2490  
!             PLANCK FUNCTION AT NEAR-SURFACE AIR TEMPERATURE IN BAND              RAD_ALL.2491  
!                                                                                  RAD_ALL.2492  
!     ARGUMENTS RELATING TO SEA ICE.                                               RAD_ALL.2493  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.2494  
     &     N_FRAC_ICE_POINT                                                        RAD_ALL.2495  
!             NUMBER OF POINTS WITH FRACTIONAL ICE COVER                           RAD_ALL.2496  
     &   , I_FRAC_ICE_POINT(NPD_PROFILE)                                           RAD_ALL.2497  
!             INDICES OF POINTS WITH FRACTIONAL ICE COVER                          RAD_ALL.2498  
      REAL  !, INTENT(IN)                                                          RAD_ALL.2499  
     &     ICE_FRACTION(NPD_PROFILE)                                               RAD_ALL.2500  
!             ICE FRACTION                                                         RAD_ALL.2501  
      REAL  !, INTENT(IN)                                                          RAD_ALL.2502  
     &     PLANCK_FREEZE_SEA                                                       RAD_ALL.2503  
!             PLANCK FUNCTION OVER FREEZING SEA                                    RAD_ALL.2504  
!                                                                                  RAD_ALL.2505  
      REAL      !, INTENT(IN)                                                      RAD_ALL.2506  
     &     WEIGHT_690NM                                                            RAD_ALL.2507  
!             WEIGHTING APPLIED TO BAND FOR REGION BELOW 690 NM                    RAD_ALL.2508  
!                                                                                  RAD_ALL.2509  
!     CALCULATED FLUXES                                                            RAD_ALL.2510  
      REAL      !, INTENT(IN)                                                      RAD_ALL.2511  
     &     FLUX_DOWN(NPD_PROFILE)                                                  RAD_ALL.2512  
!             TOTAL DOWNWARD OR NET FLUX AT SURFACE                                RAD_ALL.2513  
     &   , FLUX_DIRECT(NPD_PROFILE)                                                RAD_ALL.2514  
!             DIRECT SOLAR FLUX AT SURFACE                                         RAD_ALL.2515  
     &   , FLUX_UP(NPD_PROFILE)                                                    RAD_ALL.2516  
!             UPWARD FLUX AT SURFACE                                               RAD_ALL.2517  
     &   , FLUX_DOWN_CLEAR(NPD_PROFILE)                                            RAD_ALL.2518  
!             TOTAL CLEAR-SKY DOWNWARD OR NET FLUX AT SURFACE                      RAD_ALL.2519  
     &   , FLUX_UP_CLEAR(NPD_PROFILE)                                              RAD_ALL.2520  
!             CLEAR-SKY UPWARD FLUX AT SURFACE                                     RAD_ALL.2521  
     &   , FLUX_DIRECT_CLEAR(NPD_PROFILE)                                          RAD_ALL.2522  
!             CLEAR-SKY DIRECT SOLAR FLUX AT SURFACE                               RAD_ALL.2523  
!                                                                                  RAD_ALL.2524  
!                                                                                  RAD_ALL.2525  
!     SURFACE FLUXES FOR COUPLING OR DIAGNOSTIC USE                                RAD_ALL.2526  
      REAL      !, INTENT(INOUT)                                                   RAD_ALL.2527  
     &     SEA_FLUX(NPD_PROFILE)                                                   RAD_ALL.2528  
!             NET DOWNWARD FLUX INTO SEA                                           RAD_ALL.2529  
     &   , SURFACE_DOWN_FLUX(NPD_PROFILE)                                          RAD_ALL.2530  
!             DOWNWARD FLUX AT SURFACE                                             RAD_ALL.2531  
     &   , SURF_DOWN_CLR(NPD_PROFILE)                                              RAD_ALL.2532  
!             CLEAR-SKY DOWNWARD FLUX AT SURFACE                                   RAD_ALL.2533  
     &   , SURF_UP_CLR(NPD_PROFILE)                                                RAD_ALL.2534  
!             CLEAR-SKY UPWARD FLUX AT SURFACE                                     RAD_ALL.2535  
     &   , FLUX_BELOW_690NM_SURF(NPD_PROFILE)                                      RAD_ALL.2536  
!             SURFACE FLUX BELOW 690NM                                             RAD_ALL.2537  
!                                                                                  RAD_ALL.2538  
!                                                                                  RAD_ALL.2539  
!     LOCAL VARIABLES                                                              RAD_ALL.2540  
      INTEGER                                                                      RAD_ALL.2541  
     &     L                                                                       RAD_ALL.2542  
!             LOOP VARIABLE                                                        RAD_ALL.2543  
!                                                                                  RAD_ALL.2544  
!                                                                                  RAD_ALL.2545  
!                                                                                  RAD_ALL.2546  
!                                                                                  RAD_ALL.2547  
!     DEPENDING ON THE SOLVER THE TOTAL FLUX AVAILABLE WILL BE EITHER              RAD_ALL.2548  
!     THE NET FLUX OR THE SEPARATE UPWARD AND DOWNWARD FLUXES, HENCE               RAD_ALL.2549  
!     EACH DIAGNOSTIC MUST BE ENFOLDED IN AN IF-TEST.                              RAD_ALL.2550  
!                                                                                  RAD_ALL.2551  
!     SINCE DIFFERENTIAL FLUXES ARE USED IN THE INFRA-RED APPROPRIATE              RAD_ALL.2552  
!     PLANCKIAN SOURCES MUST BE ADDED TO NON-NET FLUXES. A SLIGHTLY                RAD_ALL.2553  
!     INEFFICIENT FORM HAS BEEN USED IN THE NON-NET CASE, DERIVED IN               RAD_ALL.2554  
!     ANALOGY WITH THE CASE OF NET FLUXES SINCE THIS MATCHES THE USE               RAD_ALL.2555  
!     OF ARRAYS IN THE MAIN CODE.                                                  RAD_ALL.2556  
!                                                                                  RAD_ALL.2557  
      IF (L_NET) THEN                                                              RAD_ALL.2558  
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                              RAD_ALL.2559  
            DO L=1, N_PROFILE                                                      RAD_ALL.2560  
               SEA_FLUX(L)=SEA_FLUX(L)+FLUX_DIRECT(L)                              RAD_ALL.2561  
     &            *(ALBEDO_SEA_DIFF(L)-ALBEDO_SEA_DIR(L))                          RAD_ALL.2562  
     &            +((1.0E+00-ALBEDO_SEA_DIFF(L))                                   RAD_ALL.2563  
     &            /(1.0E+00-ALBEDO_FIELD_DIFF(L)))                                 RAD_ALL.2564  
     &            *(FLUX_DOWN(L)-FLUX_DIRECT(L)                                    RAD_ALL.2565  
     &            *(ALBEDO_FIELD_DIFF(L)-ALBEDO_FIELD_DIR(L)))                     RAD_ALL.2566  
            ENDDO                                                                  RAD_ALL.2567  
         ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                     RAD_ALL.2568  
            DO L=1, N_PROFILE                                                      RAD_ALL.2569  
               SEA_FLUX(L)=SEA_FLUX(L)                                             RAD_ALL.2570  
     &            +(FLUX_DOWN(L)+THERMAL_SOURCE_GROUND(L))                         RAD_ALL.2571  
     &            *(1.0E+00-ALBEDO_SEA_DIFF(L))                                    RAD_ALL.2572  
     &            /(1.0E+00-ALBEDO_FIELD_DIFF(L))                                  RAD_ALL.2573  
     &            -(1.0E+00-ALBEDO_SEA_DIFF(L))*PLANCK_FREEZE_SEA                  RAD_ALL.2574  
            ENDDO                                                                  RAD_ALL.2575  
         ENDIF                                                                     RAD_ALL.2576  
      ELSE                                                                         RAD_ALL.2577  
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                              RAD_ALL.2578  
            DO L=1, N_PROFILE                                                      RAD_ALL.2579  
               SEA_FLUX(L)=SEA_FLUX(L)+FLUX_DOWN(L)-FLUX_UP(L)                     RAD_ALL.2580  
            ENDDO                                                                  RAD_ALL.2581  
         ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                     RAD_ALL.2582  
            DO L=1, N_PROFILE                                                      RAD_ALL.2583  
               SEA_FLUX(L)=SEA_FLUX(L)                                             RAD_ALL.2584  
     &            +(1.0E+00-ALBEDO_SEA_DIFF(L))                                    RAD_ALL.2585  
     &            *(FLUX_DOWN(L)+PLANCK_AIR_SURFACE(L)                             RAD_ALL.2586  
     &            -PLANCK_FREEZE_SEA)                                              RAD_ALL.2587  
            ENDDO                                                                  RAD_ALL.2588  
         ENDIF                                                                     RAD_ALL.2589  
      ENDIF                                                                        RAD_ALL.2590  
!                                                                                  RAD_ALL.2591  
      IF (L_SURFACE_DOWN_FLUX) THEN                                                RAD_ALL.2592  
         IF (L_NET) THEN                                                           RAD_ALL.2593  
            IF (ISOLIR.EQ.IP_SOLAR) THEN                                           RAD_ALL.2594  
               DO L=1, N_PROFILE                                                   RAD_ALL.2595  
                  SURFACE_DOWN_FLUX(L)=SURFACE_DOWN_FLUX(L)                        RAD_ALL.2596  
     &               +(FLUX_DOWN(L)+FLUX_DIRECT(L)                                 RAD_ALL.2597  
     &               *(ALBEDO_FIELD_DIR(L)-ALBEDO_FIELD_DIFF(L)))                  RAD_ALL.2598  
     &               /(1.0E+00-ALBEDO_FIELD_DIFF(L))                               RAD_ALL.2599  
               ENDDO                                                               RAD_ALL.2600  
            ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                  RAD_ALL.2601  
               DO L=1, N_PROFILE                                                   RAD_ALL.2602  
                  SURFACE_DOWN_FLUX(L)=SURFACE_DOWN_FLUX(L)                        RAD_ALL.2603  
     &               +(FLUX_DOWN(L)+THERMAL_SOURCE_GROUND(L))                      RAD_ALL.2604  
     &               /(1.0E+00-ALBEDO_FIELD_DIFF(L))                               RAD_ALL.2605  
               ENDDO                                                               RAD_ALL.2606  
            ENDIF                                                                  RAD_ALL.2607  
         ELSE                                                                      RAD_ALL.2608  
            IF (ISOLIR.EQ.IP_SOLAR) THEN                                           RAD_ALL.2609  
               DO L=1, N_PROFILE                                                   RAD_ALL.2610  
                  SURFACE_DOWN_FLUX(L)=SURFACE_DOWN_FLUX(L)                        RAD_ALL.2611  
     &               +FLUX_DOWN(L)                                                 RAD_ALL.2612  
               ENDDO                                                               RAD_ALL.2613  
            ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                  RAD_ALL.2614  
               DO L=1, N_PROFILE                                                   RAD_ALL.2615  
                  SURFACE_DOWN_FLUX(L)=SURFACE_DOWN_FLUX(L)                        RAD_ALL.2616  
     &               +FLUX_DOWN(L)+PLANCK_AIR_SURFACE(L)                           RAD_ALL.2617  
               ENDDO                                                               RAD_ALL.2618  
            ENDIF                                                                  RAD_ALL.2619  
         ENDIF                                                                     RAD_ALL.2620  
      ENDIF                                                                        RAD_ALL.2621  
!                                                                                  RAD_ALL.2622  
      IF (L_SURF_DOWN_CLR) THEN                                                    RAD_ALL.2623  
         IF (L_NET) THEN                                                           RAD_ALL.2624  
            IF (ISOLIR.EQ.IP_SOLAR) THEN                                           RAD_ALL.2625  
               DO L=1, N_PROFILE                                                   RAD_ALL.2626  
                  SURF_DOWN_CLR(L)=SURF_DOWN_CLR(L)                                RAD_ALL.2627  
     &               +(FLUX_DOWN_CLEAR(L)+FLUX_DIRECT_CLEAR(L)                     RAD_ALL.2628  
     &               *(ALBEDO_FIELD_DIR(L)-ALBEDO_FIELD_DIFF(L)))                  RAD_ALL.2629  
     &               /(1.0E+00-ALBEDO_FIELD_DIFF(L))                               RAD_ALL.2630  
               ENDDO                                                               RAD_ALL.2631  
            ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                  RAD_ALL.2632  
               DO L=1, N_PROFILE                                                   RAD_ALL.2633  
                  SURF_DOWN_CLR(L)=SURF_DOWN_CLR(L)                                RAD_ALL.2634  
     &               +(FLUX_DOWN_CLEAR(L)+THERMAL_SOURCE_GROUND(L))                RAD_ALL.2635  
     &               /(1.0E+00-ALBEDO_FIELD_DIFF(L))                               RAD_ALL.2636  
               ENDDO                                                               RAD_ALL.2637  
            ENDIF                                                                  RAD_ALL.2638  
         ELSE                                                                      RAD_ALL.2639  
            IF (ISOLIR.EQ.IP_SOLAR) THEN                                           RAD_ALL.2640  
               DO L=1, N_PROFILE                                                   RAD_ALL.2641  
                  SURF_DOWN_CLR(L)=SURF_DOWN_CLR(L)                                RAD_ALL.2642  
     &               +FLUX_DOWN_CLEAR(L)                                           RAD_ALL.2643  
               ENDDO                                                               RAD_ALL.2644  
            ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                  RAD_ALL.2645  
               DO L=1, N_PROFILE                                                   RAD_ALL.2646  
                  SURF_DOWN_CLR(L)=SURF_DOWN_CLR(L)                                RAD_ALL.2647  
     &               +FLUX_DOWN_CLEAR(L)+PLANCK_AIR_SURFACE(L)                     RAD_ALL.2648  
               ENDDO                                                               RAD_ALL.2649  
            ENDIF                                                                  RAD_ALL.2650  
         ENDIF                                                                     RAD_ALL.2651  
      ENDIF                                                                        RAD_ALL.2652  
!                                                                                  RAD_ALL.2653  
      IF (L_SURF_UP_CLR) THEN                                                      RAD_ALL.2654  
         IF (L_NET) THEN                                                           RAD_ALL.2655  
            IF (ISOLIR.EQ.IP_SOLAR) THEN                                           RAD_ALL.2656  
               DO L=1, N_PROFILE                                                   RAD_ALL.2657  
                  SURF_UP_CLR(L)=SURF_UP_CLR(L)                                    RAD_ALL.2658  
     &               +((ALBEDO_FIELD_DIR(L)-ALBEDO_FIELD_DIFF(L))                  RAD_ALL.2659  
     &               *FLUX_DIRECT_CLEAR(L)                                         RAD_ALL.2660  
     &               +ALBEDO_FIELD_DIFF(L)*FLUX_DOWN_CLEAR(L))                     RAD_ALL.2661  
     &               /(1.0E+00-ALBEDO_FIELD_DIFF(L))                               RAD_ALL.2662  
               ENDDO                                                               RAD_ALL.2663  
            ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                  RAD_ALL.2664  
               DO L=1, N_PROFILE                                                   RAD_ALL.2665  
                  SURF_UP_CLR(L)=SURF_UP_CLR(L)                                    RAD_ALL.2666  
     &               +(THERMAL_SOURCE_GROUND(L)+ALBEDO_FIELD_DIFF(L)               RAD_ALL.2667  
     &               *FLUX_DOWN_CLEAR(L))/(1.0E+00-ALBEDO_FIELD_DIFF(L))           RAD_ALL.2668  
               ENDDO                                                               RAD_ALL.2669  
            ENDIF                                                                  RAD_ALL.2670  
         ELSE                                                                      RAD_ALL.2671  
            IF (ISOLIR.EQ.IP_SOLAR) THEN                                           RAD_ALL.2672  
               DO L=1, N_PROFILE                                                   RAD_ALL.2673  
                  SURF_UP_CLR(L)=SURF_UP_CLR(L)                                    RAD_ALL.2674  
     &               +FLUX_UP_CLEAR(L)                                             RAD_ALL.2675  
               ENDDO                                                               RAD_ALL.2676  
            ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                  RAD_ALL.2677  
               DO L=1, N_PROFILE                                                   RAD_ALL.2678  
                  SURF_UP_CLR(L)=SURF_UP_CLR(L)                                    RAD_ALL.2679  
     &               +FLUX_UP_CLEAR(L)+PLANCK_AIR_SURFACE(L)                       RAD_ALL.2680  
               ENDDO                                                               RAD_ALL.2681  
            ENDIF                                                                  RAD_ALL.2682  
         ENDIF                                                                     RAD_ALL.2683  
      ENDIF                                                                        RAD_ALL.2684  
!                                                                                  RAD_ALL.2685  
!     THIS DIAGNOSTIC IS AVAILABLE ONLY IN THE SOLAR REGION.                       RAD_ALL.2686  
      IF (L_FLUX_BELOW_690NM_SURF) THEN                                            RAD_ALL.2687  
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                              RAD_ALL.2688  
            IF (L_NET) THEN                                                        RAD_ALL.2689  
               DO L=1, N_PROFILE                                                   RAD_ALL.2690  
                  FLUX_BELOW_690NM_SURF(L)=FLUX_BELOW_690NM_SURF(L)                RAD_ALL.2691  
     &               +WEIGHT_690NM*FLUX_DOWN(L)                                    RAD_ALL.2692  
               ENDDO                                                               RAD_ALL.2693  
            ELSE                                                                   RAD_ALL.2694  
               DO L=1, N_PROFILE                                                   RAD_ALL.2695  
                  FLUX_BELOW_690NM_SURF(L)=FLUX_BELOW_690NM_SURF(L)                RAD_ALL.2696  
     &               +WEIGHT_690NM*(FLUX_DOWN(L)-FLUX_UP(L))                       RAD_ALL.2697  
               ENDDO                                                               RAD_ALL.2698  
            ENDIF                                                                  RAD_ALL.2699  
         ENDIF                                                                     RAD_ALL.2700  
      ENDIF                                                                        RAD_ALL.2701  
!                                                                                  RAD_ALL.2702  
!                                                                                  RAD_ALL.2703  
!                                                                                  RAD_ALL.2704  
      RETURN                                                                       RAD_ALL.2705  
      END  
