C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.10447 
C                                                                                  RAD_ALL.10448 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.10449 
C restrictions as set forth in the contract.                                       RAD_ALL.10450 
C                                                                                  RAD_ALL.10451 
C                Meteorological Office                                             RAD_ALL.10452 
C                London Road                                                       RAD_ALL.10453 
C                BRACKNELL                                                         RAD_ALL.10454 
C                Berkshire UK                                                      RAD_ALL.10455 
C                RG12 2SZ                                                          RAD_ALL.10456 
C                                                                                  RAD_ALL.10457 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.10458 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.10459 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.10460 
C Modelling at the above address.                                                  RAD_ALL.10461 
C ******************************COPYRIGHT******************************            RAD_ALL.10462 
C                                                                                  RAD_ALL.10463 
!+ Subroutine implementing an endekadiagonal solution of the equations.            RAD_ALL.10464 
!                                                                                  RAD_ALL.10465 
! Method:                                                                          RAD_ALL.10466 
!       This subroutine calls subroutines to set the endekadiagonal                RAD_ALL.10467 
!       matrix for the clear and cloudy upward and downward fluxes                 RAD_ALL.10468 
!       and to solve those equations. It is kept separate to avoid                 RAD_ALL.10469 
!       allocating space for so large a matrix in the upper routine                RAD_ALL.10470 
!       when that is used in a GCM and this routine is very                        RAD_ALL.10471 
!       unlikely to be used.                                                       RAD_ALL.10472 
!                                                                                  RAD_ALL.10473 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.10474 
!                                                                                  RAD_ALL.10475 
! History:                                                                         RAD_ALL.10476 
!       Version         Date                    Comment                            RAD_ALL.10477 
!       4.0             27-07-95                Original Code                      RAD_ALL.10478 
!                                               (J. M. Edwards)                    RAD_ALL.10479 
!                                                                                  RAD_ALL.10480 
! Description of Code:                                                             RAD_ALL.10481 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.10482 
!                                                                                  RAD_ALL.10483 
!- ---------------------------------------------------------------------           RAD_ALL.10484 
      SUBROUTINE MIX_COLUMN_FULL(N_PROFILE, N_LAYER, N_CLOUD_TOP                   RAD_ALL.10485 
     &   , T_FREE, R_FREE, S_DOWN_FREE, S_UP_FREE                                  RAD_ALL.10486 
     &   , T_CLOUD, R_CLOUD, S_DOWN_CLOUD, S_UP_CLOUD                              RAD_ALL.10487 
     &   , G_M, G_P, B_M, B_P                                                      RAD_ALL.10488 
     &   , FLUX_INC_DOWN                                                           RAD_ALL.10489 
     &   , SOURCE_GROUND, ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                  RAD_ALL.10490 
     &   , FLUX_DIRECT_GROUND                                                      RAD_ALL.10491 
     &   , FLUX_TOTAL                                                              RAD_ALL.10492 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.10493 
     &   )                                                                         RAD_ALL.10494 
!                                                                                  RAD_ALL.10495 
!                                                                                  RAD_ALL.10496 
!                                                                                  RAD_ALL.10497 
      IMPLICIT NONE                                                                RAD_ALL.10498 
!                                                                                  RAD_ALL.10499 
!                                                                                  RAD_ALL.10500 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.10501 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.10502 
     &     NPD_PROFILE                                                             RAD_ALL.10503 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.10504 
     &   , NPD_LAYER                                                               RAD_ALL.10505 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.10506 
!                                                                                  RAD_ALL.10507 
!                                                                                  RAD_ALL.10508 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.10509 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.10510 
     &     N_PROFILE                                                               RAD_ALL.10511 
!             NUMBER OF PROFILES                                                   RAD_ALL.10512 
     &   , N_LAYER                                                                 RAD_ALL.10513 
!             NUMBER OF LAYERS                                                     RAD_ALL.10514 
     &   , N_CLOUD_TOP                                                             RAD_ALL.10515 
!             TOPMOST CLOUDY LAYER                                                 RAD_ALL.10516 
      REAL      !, INTENT(IN)                                                      RAD_ALL.10517 
     &     T_FREE(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.10518 
!             FREE TRANSMISSION                                                    RAD_ALL.10519 
     &   , R_FREE(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.10520 
!             FREE REFLECTION                                                      RAD_ALL.10521 
     &   , S_DOWN_FREE(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.10522 
!             FREE DOWNWARD SOURCE FUNCTION                                        RAD_ALL.10523 
     &   , S_UP_FREE(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.10524 
!             FREE UPWARD SOURCE FUNCTION                                          RAD_ALL.10525 
     &   , T_CLOUD(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.10526 
!             CLOUDY TRANSMISSION                                                  RAD_ALL.10527 
     &   , R_CLOUD(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.10528 
!             CLOUDY REFLECTION                                                    RAD_ALL.10529 
     &   , S_DOWN_CLOUD(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.10530 
!             DOWNWARD CLOUDY SOURCE FUNCTION                                      RAD_ALL.10531 
     &   , S_UP_CLOUD(NPD_PROFILE, NPD_LAYER)                                      RAD_ALL.10532 
!             UPWARD CLOUDY SOURCE FUNCTION                                        RAD_ALL.10533 
      REAL      !, INTENT(IN)                                                      RAD_ALL.10534 
     &     B_M(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.10535 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10536 
     &   , B_P(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.10537 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10538 
     &   , G_M(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.10539 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10540 
     &   , G_P(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.10541 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10542 
      REAL      !, INTENT(IN)                                                      RAD_ALL.10543 
     &     FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.10544 
!             INCIDENT TOTAL FLUX                                                  RAD_ALL.10545 
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.10546 
!             SOURCE FROM GROUND                                                   RAD_ALL.10547 
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.10548 
!             DIFFUSE ALBEDO                                                       RAD_ALL.10549 
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                         RAD_ALL.10550 
!             DIRECT ALBEDO                                                        RAD_ALL.10551 
     &   , FLUX_DIRECT_GROUND(NPD_PROFILE)                                         RAD_ALL.10552 
!             DIRECT FLUX AT GROUND                                                RAD_ALL.10553 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.10554 
     &     FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2)                                  RAD_ALL.10555 
!             TOTAL FLUX                                                           RAD_ALL.10556 
!                                                                                  RAD_ALL.10557 
!     LOCAL VARIABLES.                                                             RAD_ALL.10558 
      INTEGER                                                                      RAD_ALL.10559 
     &     I                                                                       RAD_ALL.10560 
!             LOOP VARIABLE                                                        RAD_ALL.10561 
     &   , L                                                                       RAD_ALL.10562 
!             LOOP VARIABLE                                                        RAD_ALL.10563 
     &   , N_EQUATION                                                              RAD_ALL.10564 
!             NUMBER OF EQUATIONS                                                  RAD_ALL.10565 
      REAL                                                                         RAD_ALL.10566 
     &     A11(NPD_PROFILE, 11, 4*NPD_LAYER+4)                                     RAD_ALL.10567 
!             MATRIX TO BE SOLVED                                                  RAD_ALL.10568 
     &   , B(NPD_PROFILE, 4*NPD_LAYER+4)                                           RAD_ALL.10569 
!             RIGHT-HAND SIDE OF EQUATION                                          RAD_ALL.10570 
     &   , X(NPD_PROFILE, 4*NPD_LAYER+4)                                           RAD_ALL.10571 
!             SOLUTION TO MATRIX EQUATION                                          RAD_ALL.10572 
     &   , WORK(NPD_PROFILE)                                                       RAD_ALL.10573 
!             WORKING ARRAY                                                        RAD_ALL.10574 
!                                                                                  RAD_ALL.10575 
!     SUBROUTINES CALLED:                                                          RAD_ALL.10576 
      EXTERNAL                                                                     RAD_ALL.10577 
     &     MIX_MATRIX_ELEM, BAND_SOLVER                                            RAD_ALL.10578 
!                                                                                  RAD_ALL.10579 
!                                                                                  RAD_ALL.10580 
!                                                                                  RAD_ALL.10581 
!     ASSIGN THE ELEMENTS OF THE MATRIX A11 AND THE VECTOR B.                      RAD_ALL.10582 
      CALL MIX_MATRIX_ELEM(N_PROFILE, N_LAYER, N_CLOUD_TOP                         RAD_ALL.10583 
     &   , T_FREE, R_FREE, S_DOWN_FREE, S_UP_FREE                                  RAD_ALL.10584 
     &   , T_CLOUD, R_CLOUD, S_DOWN_CLOUD, S_UP_CLOUD                              RAD_ALL.10585 
     &   , G_M, G_P, B_M, B_P                                                      RAD_ALL.10586 
     &   , FLUX_INC_DOWN                                                           RAD_ALL.10587 
     &   , SOURCE_GROUND, ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                  RAD_ALL.10588 
     &   , FLUX_DIRECT_GROUND                                                      RAD_ALL.10589 
     &   , A11, B                                                                  RAD_ALL.10590 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.10591 
     &   )                                                                         RAD_ALL.10592 
!                                                                                  RAD_ALL.10593 
      N_EQUATION=4*N_LAYER+4                                                       RAD_ALL.10594 
      CALL BAND_SOLVER(N_PROFILE, N_EQUATION                                       RAD_ALL.10595 
     &   , 5, 5                                                                    RAD_ALL.10596 
     &   , A11, B                                                                  RAD_ALL.10597 
     &   , X                                                                       RAD_ALL.10598 
     &   , NPD_PROFILE, 4*NPD_LAYER+4                                              RAD_ALL.10599 
     &   , WORK                                                                    RAD_ALL.10600 
     &   )                                                                         RAD_ALL.10601 
!                                                                                  RAD_ALL.10602 
!     PICK OUT THE SUMMED FLUXES FROM THE LONG VECTOR                              RAD_ALL.10603 
      DO I=1, 2*N_LAYER+2                                                          RAD_ALL.10604 
         DO L=1, N_PROFILE                                                         RAD_ALL.10605 
            FLUX_TOTAL(L, I)=X(L, 2*I)                                             RAD_ALL.10606 
         ENDDO                                                                     RAD_ALL.10607 
      ENDDO                                                                        RAD_ALL.10608 
!                                                                                  RAD_ALL.10609 
!                                                                                  RAD_ALL.10610 
      RETURN                                                                       RAD_ALL.10611 
      END 
