C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.13868 
C                                                                                  RAD_ALL.13869 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.13870 
C restrictions as set forth in the contract.                                       RAD_ALL.13871 
C                                                                                  RAD_ALL.13872 
C                Meteorological Office                                             RAD_ALL.13873 
C                London Road                                                       RAD_ALL.13874 
C                BRACKNELL                                                         RAD_ALL.13875 
C                Berkshire UK                                                      RAD_ALL.13876 
C                RG12 2SZ                                                          RAD_ALL.13877 
C                                                                                  RAD_ALL.13878 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.13879 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.13880 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.13881 
C Modelling at the above address.                                                  RAD_ALL.13882 
C ******************************COPYRIGHT******************************            RAD_ALL.13883 
C                                                                                  RAD_ALL.13884 
!+ Subroutine to precondition the tridiagonal matrix.                              RAD_ALL.13885 
!                                                                                  RAD_ALL.13886 
! Method:                                                                          RAD_ALL.13887 
!       The reflection coefficient in each layer of modified so                    RAD_ALL.13888 
!       that is never becomes too small, thus avoiding                             RAD_ALL.13889 
!       ill-conditioning.                                                          RAD_ALL.13890 
!                                                                                  RAD_ALL.13891 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.13892 
!                                                                                  RAD_ALL.13893 
! History:                                                                         RAD_ALL.13894 
!       Version         Date                    Comment                            RAD_ALL.13895 
!       4.0             27-07-95                Original Code                      RAD_ALL.13896 
!                                               (J. M. Edwards)                    RAD_ALL.13897 
!                                                                                  RAD_ALL.13898 
! Description of Code:                                                             RAD_ALL.13899 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.13900 
!                                                                                  RAD_ALL.13901 
!- ---------------------------------------------------------------------           RAD_ALL.13902 
      SUBROUTINE PRECONDITIONER_CLEAR(N_PROFILE, N_LAYER                           RAD_ALL.13903 
     &   , A3, B                                                                   RAD_ALL.13904 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.13905 
     &   )                                                                         RAD_ALL.13906 
!                                                                                  RAD_ALL.13907 
!                                                                                  RAD_ALL.13908 
      IMPLICIT NONE                                                                RAD_ALL.13909 
!                                                                                  RAD_ALL.13910 
!                                                                                  RAD_ALL.13911 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.13912 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.13913 
     &     NPD_PROFILE                                                             RAD_ALL.13914 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.13915 
     &   , NPD_LAYER                                                               RAD_ALL.13916 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.13917 
!                                                                                  RAD_ALL.13918 
!     INCLUDE COMDECKS.                                                            RAD_ALL.13919 
!     ------------------------------------------------------------------           PRMCH3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       PRMCH3A.3     
!                                                                                  PRMCH3A.4     
!     MODULE FOR SETTING MACHINE PRECISION.                                        PRMCH3A.5     
!                                                                                  PRMCH3A.6     
      REAL                                                                         PRMCH3A.7     
     &     TOL_MACHINE                                                             PRMCH3A.8     
!             MACHINE TOLERANCE                                                    PRMCH3A.9     
     &   , SQRT_TOL_MACHINE                                                        PRMCH3A.10    
!             SQRT OF MACHINE TOLERANCE                                            PRMCH3A.11    
!                                                                                  PRMCH3A.12    
!                                                                                  PRMCH3A.13    
!     THE PRECISION SHOULD BE ABOUT 2/2^(SIZE OF SIGNIFICAND)                      PRMCH3A.14    
!                                                                                  PRMCH3A.15    
!     THE IEEE-FORMAT USES 53 BITS FOR THE SIGNIFICAND                             PRMCH3A.16    
!     IN DOUBLE PRECISION                                                          PRMCH3A.17    
!                                                                                  PRMCH3A.18    
!     THE CRAY FORMAT USES 47 BITS IN SINGLE PRECISION.                            PRMCH3A.19    
!                                                                                  PRMCH3A.20    
      PARAMETER(                                                                   PRMCH3A.21    
     &     TOL_MACHINE=1.42E-14                                                    PRMCH3A.22    
     &   , SQRT_TOL_MACHINE=1.19E-7                                                PRMCH3A.23    
     &   )                                                                         PRMCH3A.24    
!                                                                                  PRMCH3A.25    
!     ------------------------------------------------------------------           PRMCH3A.26    
!                                                                                  RAD_ALL.13921 
!     DUMMY VARIABLES.                                                             RAD_ALL.13922 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.13923 
     &     N_PROFILE                                                               RAD_ALL.13924 
!             NUMBER OF PROFILES                                                   RAD_ALL.13925 
     &   , N_LAYER                                                                 RAD_ALL.13926 
!             NUMBER OF LAYERS                                                     RAD_ALL.13927 
      REAL      !, INTENT(IN)                                                      RAD_ALL.13928 
     &     A3(NPD_PROFILE, 3, 2*NPD_LAYER+2)                                       RAD_ALL.13929 
!             TRIDIAGONAL MATRIX                                                   RAD_ALL.13930 
     &   , B(NPD_PROFILE, 2*NPD_LAYER+2)                                           RAD_ALL.13931 
!             SOURCE TERMS                                                         RAD_ALL.13932 
!                                                                                  RAD_ALL.13933 
!     LOCAL VARIABLES                                                              RAD_ALL.13934 
      INTEGER                                                                      RAD_ALL.13935 
     &     I                                                                       RAD_ALL.13936 
!             LOOP VARIABLE                                                        RAD_ALL.13937 
     &   , L                                                                       RAD_ALL.13938 
!             LOOP VARIABLE                                                        RAD_ALL.13939 
      REAL                                                                         RAD_ALL.13940 
     &     PERTURBATION                                                            RAD_ALL.13941 
!             PERTURBATION TO REFLECTION COEFF                                     RAD_ALL.13942 
!                                                                                  RAD_ALL.13943 
!                                                                                  RAD_ALL.13944 
!     THE REFLECTION COEFFICIENT IN EACH LAYER IS PERTURBED TO ENSURE              RAD_ALL.13945 
!     THAT IT MAY NEVER FALL BELOW THE SQUARE ROOT OF THE TOLERANCE OF             RAD_ALL.13946 
!     THE MACHINE, THUS AVOIDING ILL-CONDITIONING. AS A PARTIAL                    RAD_ALL.13947 
!     CORRECTION THE SOURCE TERM IS MODIFIED ON THE ASSUMPTION THAT                RAD_ALL.13948 
!     THE FLUX EMANATING FROM A LAYER IS EQUAL TO THE CORRESPONDING                RAD_ALL.13949 
!     SOURCE TERM. THIS SHOULD BE A GOOD APPROXIMATION WHEN THE LAYER              RAD_ALL.13950 
!     IS OPTICALLY THICK; BUT IT IS LESS CLEAR WHAT ONE SHOULD DO                  RAD_ALL.13951 
!     IN TRANSPARENT LAYERS.                                                       RAD_ALL.13952 
      DO I=1, N_LAYER                                                              RAD_ALL.13953 
         DO L=1, N_PROFILE                                                         RAD_ALL.13954 
            PERTURBATION=TOL_MACHINE/(A3(L, 2, 2*I)+SQRT_TOL_MACHINE)              RAD_ALL.13955 
            A3(L, 2, 2*I)=A3(L, 2, 2*I)+PERTURBATION                               RAD_ALL.13956 
            B(L, 2*I)=B(L, 2*I)-PERTURBATION*B(L, 2*I-1)                           RAD_ALL.13957 
            A3(L, 2, 2*I+1)=A3(L, 2, 2*I+1)+PERTURBATION                           RAD_ALL.13958 
            B(L, 2*I+1)=B(L, 2*I+1)-PERTURBATION*B(L, 2*I+2)                       RAD_ALL.13959 
         ENDDO                                                                     RAD_ALL.13960 
      ENDDO                                                                        RAD_ALL.13961 
!     THE SURFACE CONDITION:                                                       RAD_ALL.13962 
      DO L=1, N_PROFILE                                                            RAD_ALL.13963 
         PERTURBATION=TOL_MACHINE/(A3(L, 2, 2*N_LAYER+2)                           RAD_ALL.13964 
     &      +SQRT_TOL_MACHINE)                                                     RAD_ALL.13965 
         A3(L, 2, 2*N_LAYER+2)=A3(l, 2, 2*N_LAYER+2)+PERTURBATION                  RAD_ALL.13966 
         B(L, 2*N_LAYER+2)=B(L, 2*N_LAYER+2)                                       RAD_ALL.13967 
     &      -PERTURBATION*B(L, 2*N_LAYER+1)                                        RAD_ALL.13968 
      ENDDO                                                                        RAD_ALL.13969 
!                                                                                  RAD_ALL.13970 
!                                                                                  RAD_ALL.13971 
      RETURN                                                                       RAD_ALL.13972 
      END
