C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.9448  
C                                                                                  RAD_ALL.9449  
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.9450  
C restrictions as set forth in the contract.                                       RAD_ALL.9451  
C                                                                                  RAD_ALL.9452  
C                Meteorological Office                                             RAD_ALL.9453  
C                London Road                                                       RAD_ALL.9454  
C                BRACKNELL                                                         RAD_ALL.9455  
C                Berkshire UK                                                      RAD_ALL.9456  
C                RG12 2SZ                                                          RAD_ALL.9457  
C                                                                                  RAD_ALL.9458  
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.9459  
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.9460  
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.9461  
C Modelling at the above address.                                                  RAD_ALL.9462  
C ******************************COPYRIGHT******************************            RAD_ALL.9463  
C                                                                                  RAD_ALL.9464  
!+ Subroutine to calculate the infra-red radiance ignoring scattering.             RAD_ALL.9465  
!                                                                                  RAD_ALL.9466  
! Method:                                                                          RAD_ALL.9467  
!       Using the secant of the ray transmission coefficients for                  RAD_ALL.9468  
!       each layer may be defined and source terms may be calculated.              RAD_ALL.9469  
!       The upward and downward radiances are integrated along                     RAD_ALL.9470  
!       their paths.                                                               RAD_ALL.9471  
!                                                                                  RAD_ALL.9472  
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.9473  
!                                                                                  RAD_ALL.9474  
! History:                                                                         RAD_ALL.9475  
!       Version         Date                    Comment                            RAD_ALL.9476  
!       4.0             27-07-95                Original Code                      RAD_ALL.9477  
!                                               (J. M. Edwards)                    RAD_ALL.9478  
!                                                                                  RAD_ALL.9479  
! Description of Code:                                                             RAD_ALL.9480  
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.9481  
!                                                                                  RAD_ALL.9482  
!- ---------------------------------------------------------------------           RAD_ALL.9483  
      SUBROUTINE MONOCHROMATIC_IR_RADIANCE(N_PROFILE, N_LAYER                      RAD_ALL.9484  
     &   , L_NET                                                                   RAD_ALL.9485  
     &   , TAU                                                                     RAD_ALL.9486  
     &   , RAD_INC_DOWN                                                            RAD_ALL.9487  
     &   , DIFF_PLANCK, SOURCE_GROUND, ALBEDO_SURFACE_DIFF                         RAD_ALL.9488  
     &   , SECANT_RAY                                                              RAD_ALL.9489  
     &   , RADIANCE                                                                RAD_ALL.9490  
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.9491  
     &         )                                                                   RAD_ALL.9492  
!                                                                                  RAD_ALL.9493  
!                                                                                  RAD_ALL.9494  
      IMPLICIT NONE                                                                RAD_ALL.9495  
!                                                                                  RAD_ALL.9496  
!                                                                                  RAD_ALL.9497  
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.9498  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.9499  
     &     NPD_PROFILE                                                             RAD_ALL.9500  
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.9501  
     &   , NPD_LAYER                                                               RAD_ALL.9502  
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.9503  
!                                                                                  RAD_ALL.9504  
!     INCLUDE COMDECKS                                                             RAD_ALL.9505  
!     ------------------------------------------------------------------           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.9507  
!     DUMMY ARGUMENTS.                                                             RAD_ALL.9508  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.9509  
     &     N_PROFILE                                                               RAD_ALL.9510  
!             NUMBER OF PROFILES                                                   RAD_ALL.9511  
     &   , N_LAYER                                                                 RAD_ALL.9512  
!             NUMBER OF LAYERS                                                     RAD_ALL.9513  
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.9514  
     &     L_NET                                                                   RAD_ALL.9515  
!             CALCULATE NET FLUXES.                                                RAD_ALL.9516  
      REAL      !, INTENT(IN)                                                      RAD_ALL.9517  
     &     TAU(NPD_PROFILE, NPD_LAYER)                                             RAD_ALL.9518  
!             OPTICAL DEPTHS OF LAYERS                                             RAD_ALL.9519  
     &   , RAD_INC_DOWN(NPD_PROFILE)                                               RAD_ALL.9520  
!             INCIDENT DOWNWARD RADIANCE                                           RAD_ALL.9521  
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.9522  
!             SOURCE FUNCTION OF GROUND                                            RAD_ALL.9523  
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.9524  
!             DIFFUSE ALBEDO                                                       RAD_ALL.9525  
     &   , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.9526  
!             DIFFERENCE IN PLANCK FUNCTION                                        RAD_ALL.9527  
     &   , SECANT_RAY                                                              RAD_ALL.9528  
!             SECANT OF ANGLE WITH VERTICAL                                        RAD_ALL.9529  
      REAL      !, INTENT(OUT)                                                     RAD_ALL.9530  
     &     RADIANCE(NPD_PROFILE, 2*NPD_LAYER+2)                                    RAD_ALL.9531  
!             DIFFUSE RADIANCE                                                     RAD_ALL.9532  
!                                                                                  RAD_ALL.9533  
!     LOCAL VARIABLES.                                                             RAD_ALL.9534  
      INTEGER                                                                      RAD_ALL.9535  
     &     I                                                                       RAD_ALL.9536  
!             LOOP VARIABLE                                                        RAD_ALL.9537  
     &   , L                                                                       RAD_ALL.9538  
!             LOOP VARIABLE                                                        RAD_ALL.9539  
      REAL                                                                         RAD_ALL.9540  
     &     TRANS(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.9541  
!             TRANSMISSIVITIES                                                     RAD_ALL.9542  
     &   , SOURCE_UP(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.9543  
!             UPWARD SOURCE FUNCTION                                               RAD_ALL.9544  
     &   , SOURCE_DOWN(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.9545  
!             DOWNWARD SOURCE FUNCTION                                             RAD_ALL.9546  
!                                                                                  RAD_ALL.9547  
!                                                                                  RAD_ALL.9548  
      DO I=1, N_LAYER                                                              RAD_ALL.9549  
         DO L=1, N_PROFILE                                                         RAD_ALL.9550  
            TRANS(L, I)=EXP(-SECANT_RAY*TAU(L, I))                                 RAD_ALL.9551  
         ENDDO                                                                     RAD_ALL.9552  
      ENDDO                                                                        RAD_ALL.9553  
!                                                                                  RAD_ALL.9554  
      DO I=1, N_LAYER                                                              RAD_ALL.9555  
         DO L=1, N_PROFILE                                                         RAD_ALL.9556  
            SOURCE_UP(L, I)=(1.0E+00-TRANS(L, I)+SQRT_TOL_MACHINE)                 RAD_ALL.9557  
     &         *DIFF_PLANCK(L, I)                                                  RAD_ALL.9558  
     &         /(SECANT_RAY*TAU(L, I)+SQRT_TOL_MACHINE)                            RAD_ALL.9559  
            SOURCE_DOWN(L, I)=-SOURCE_UP(L, I)                                     RAD_ALL.9560  
         ENDDO                                                                     RAD_ALL.9561  
      ENDDO                                                                        RAD_ALL.9562  
!                                                                                  RAD_ALL.9563  
!     DOWNWARD RADIANCE.                                                           RAD_ALL.9564  
      DO L=1, N_PROFILE                                                            RAD_ALL.9565  
         RADIANCE(L, 2)=RAD_INC_DOWN(L)                                            RAD_ALL.9566  
      ENDDO                                                                        RAD_ALL.9567  
      DO I=1, N_LAYER                                                              RAD_ALL.9568  
         DO L=1, N_PROFILE                                                         RAD_ALL.9569  
            RADIANCE(L, 2*I+2)=TRANS(L, I)*RADIANCE(L, 2*I)                        RAD_ALL.9570  
     &         +SOURCE_DOWN(L, I)                                                  RAD_ALL.9571  
         ENDDO                                                                     RAD_ALL.9572  
      ENDDO                                                                        RAD_ALL.9573  
!                                                                                  RAD_ALL.9574  
!     UPWARD RADIANCE.                                                             RAD_ALL.9575  
      DO L=1, N_PROFILE                                                            RAD_ALL.9576  
         RADIANCE(L, 2*N_LAYER+1)=SOURCE_GROUND(L)                                 RAD_ALL.9577  
     &      +ALBEDO_SURFACE_DIFF(L)*RADIANCE(L, 2*N_LAYER+2)                       RAD_ALL.9578  
      ENDDO                                                                        RAD_ALL.9579  
      DO I=N_LAYER, 1, -1                                                          RAD_ALL.9580  
         DO L=1, N_PROFILE                                                         RAD_ALL.9581  
            RADIANCE(L, 2*I-1)=TRANS(L, I)*RADIANCE(L, 2*I+1)                      RAD_ALL.9582  
     &         +SOURCE_UP(L, I)                                                    RAD_ALL.9583  
         ENDDO                                                                     RAD_ALL.9584  
      ENDDO                                                                        RAD_ALL.9585  
!                                                                                  RAD_ALL.9586  
!     REDUCE TO A NET RADIANCE IF THIS IS REQUIRED.                                RAD_ALL.9587  
      IF (L_NET) THEN                                                              RAD_ALL.9588  
         DO I=0, N_LAYER                                                           RAD_ALL.9589  
            DO L=1, N_PROFILE                                                      RAD_ALL.9590  
               RADIANCE(L, I+1)=RADIANCE(L, 2*I+2)                                 RAD_ALL.9591  
     &            -RADIANCE(L, 2*I+1)                                              RAD_ALL.9592  
            ENDDO                                                                  RAD_ALL.9593  
         ENDDO                                                                     RAD_ALL.9594  
      ENDIF                                                                        RAD_ALL.9595  
!                                                                                  RAD_ALL.9596  
!                                                                                  RAD_ALL.9597  
      RETURN                                                                       RAD_ALL.9598  
      END  
