C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.26436 
C                                                                                  RAD_ALL.26437 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.26438 
C restrictions as set forth in the contract.                                       RAD_ALL.26439 
C                                                                                  RAD_ALL.26440 
C                Meteorological Office                                             RAD_ALL.26441 
C                London Road                                                       RAD_ALL.26442 
C                BRACKNELL                                                         RAD_ALL.26443 
C                Berkshire UK                                                      RAD_ALL.26444 
C                RG12 2SZ                                                          RAD_ALL.26445 
C                                                                                  RAD_ALL.26446 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.26447 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.26448 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.26449 
C Modelling at the above address.                                                  RAD_ALL.26450 
C ******************************COPYRIGHT******************************            RAD_ALL.26451 
C                                                                                  RAD_ALL.26452 
!+ Subroutine to calculate transmission and reflection coefficients.               RAD_ALL.26453 
!                                                                                  RAD_ALL.26454 
! Method:                                                                          RAD_ALL.26455 
!        Straightforward.                                                          RAD_ALL.26456 
!                                                                                  RAD_ALL.26457 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.26458 
!                                                                                  RAD_ALL.26459 
! History:                                                                         RAD_ALL.26460 
!       Version         Date                    Comment                            RAD_ALL.26461 
!       4.0             27-07-95                Original Code                      RAD_ALL.26462 
!                                               (J. M. Edwards)                    RAD_ALL.26463 
!       4.1             29-03-96                Half-precision                     RAD_ALL.26464 
!                                               exponential introduced.            RAD_ALL.26465 
!                                               (J. M. Edwards)                    RAD_ALL.26466 
!       4.2             Oct. 96     T3E migration: HF functions                    RAD_ALL.26467 
!                                   replaced by T3E vec_lib functions              RAD_ALL.26468 
!                                               (S.J.Swarbrick)                    RAD_ALL.26469 
!                                                                                  RAD_ALL.26470 
! Description of Code:                                                             RAD_ALL.26471 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.26472 
!                                                                                  RAD_ALL.26473 
!- ---------------------------------------------------------------------           RAD_ALL.26474 
      SUBROUTINE TRANS_SOURCE_COEFF(N_PROFILE                                      RAD_ALL.26475 
     &   , I_LAYER_FIRST, I_LAYER_LAST                                             RAD_ALL.26476 
     &   , ISOLIR, L_IR_SOURCE_QUAD                                                RAD_ALL.26477 
     &   , TAU, SUM, DIFF, LAMBDA, SEC_0                                           RAD_ALL.26478 
     &   , GAMMA_UP, GAMMA_DOWN                                                    RAD_ALL.26479 
     &   , TRANS, REFLECT, TRANS_0, SOURCE_COEFF                                   RAD_ALL.26480 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.26481 
     &   )                                                                         RAD_ALL.26482 
!                                                                                  RAD_ALL.26483 
!                                                                                  RAD_ALL.26484 
      IMPLICIT NONE                                                                RAD_ALL.26485 
!                                                                                  RAD_ALL.26486 
!                                                                                  RAD_ALL.26487 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.26488 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.26489 
     &     NPD_PROFILE                                                             RAD_ALL.26490 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.26491 
     &   , NPD_LAYER                                                               RAD_ALL.26492 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.26493 
!                                                                                  RAD_ALL.26494 
!     COMDECKS INCLUDED                                                            RAD_ALL.26495 
!     ------------------------------------------------------------------           DIMFIX3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       DIMFIX3A.3     
!                                                                                  DIMFIX3A.4     
!     MODULE TO SET INTERNAL DIMENSIONS TIED TO ALGORITHMS,                        DIMFIX3A.5     
!     MOSTLY FOR CLOUDS.                                                           DIMFIX3A.6     
!                                                                                  DIMFIX3A.7     
      INTEGER                                                                      DIMFIX3A.8     
     &     NPD_CLOUD_COMPONENT                                                     DIMFIX3A.9     
!             NUMBER OF COMPONENTS OF CLOUDS                                       DIMFIX3A.10    
     &   , NPD_CLOUD_TYPE                                                          DIMFIX3A.11    
!             NUMBER OF PERMITTED TYPES OF CLOUDS.                                 DIMFIX3A.12    
     &   , NPD_CLOUD_REPRESENTATION                                                DIMFIX3A.13    
!             NUMBER OF PERMITTED REPRESENTATIONS OF CLOUDS.                       DIMFIX3A.14    
     &   , NPD_OVERLAP_COEFF                                                       DIMFIX3A.15    
!             NUMBER OF OVERLAP COEFFICIENTS FOR CLOUDS                            DIMFIX3A.16    
     &   , NPD_SOURCE_COEFF                                                        DIMFIX3A.17    
!             NUMBER OF COEFFICIENTS FOR TWO-STREAM SOURCES                        DIMFIX3A.18    
     &   , NPD_REGION                                                              DIMFIX3A.19    
!             NUMBER OF REGIONS IN A LAYER                                         DIMFIX3A.20    
!                                                                                  DIMFIX3A.21    
      PARAMETER(                                                                   DIMFIX3A.22    
     &     NPD_CLOUD_COMPONENT=4                                                   DIMFIX3A.23    
     &   , NPD_CLOUD_TYPE=4                                                        DIMFIX3A.24    
     &   , NPD_CLOUD_REPRESENTATION=4                                              DIMFIX3A.25    
     &   , NPD_OVERLAP_COEFF=18                                                    DIMFIX3A.26    
     &   , NPD_SOURCE_COEFF=2                                                      DIMFIX3A.27    
     &   , NPD_REGION=3                                                            DIMFIX3A.28    
     &   )                                                                         DIMFIX3A.29    
!                                                                                  DIMFIX3A.30    
!     ------------------------------------------------------------------           DIMFIX3A.31    
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           SCFPT3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       SCFPT3A.3     
!                                                                                  SCFPT3A.4     
!     MODULE TO SET POINTERS TO SOURCE COEFFICIENTS.                               SCFPT3A.5     
!                                                                                  SCFPT3A.6     
      INTEGER                                                                      SCFPT3A.7     
     &     IP_SCF_SOLAR_UP                                                         SCFPT3A.8     
!             POINTER TO SOURCE COEFICIENT FOR UPWARD SOLAR BEAM                   SCFPT3A.9     
     &   , IP_SCF_SOLAR_DOWN                                                       SCFPT3A.10    
!             POINTER TO SOURCE COEFICIENT FOR DOWNWARD SOLAR BEAM                 SCFPT3A.11    
     &   , IP_SCF_IR_1D                                                            SCFPT3A.12    
!             POINTER TO SOURCE COEFICIENT                                         SCFPT3A.13    
!             FOR 1ST DIFFERENCE OF PLANCKIAN                                      SCFPT3A.14    
     &   , IP_SCF_IR_2D                                                            SCFPT3A.15    
!             POINTER TO SOURCE COEFICIENT                                         SCFPT3A.16    
!             FOR 2ND DIFFERENCE OF PLANCKIAN                                      SCFPT3A.17    
!                                                                                  SCFPT3A.18    
      PARAMETER(                                                                   SCFPT3A.19    
     &     IP_SCF_SOLAR_UP=1                                                       SCFPT3A.20    
     &   , IP_SCF_SOLAR_DOWN=2                                                     SCFPT3A.21    
     &   , IP_SCF_IR_1D=1                                                          SCFPT3A.22    
     &   , IP_SCF_IR_2D=2                                                          SCFPT3A.23    
     &   )                                                                         SCFPT3A.24    
!                                                                                  SCFPT3A.25    
!     ------------------------------------------------------------------           SCFPT3A.26    
!                                                                                  RAD_ALL.26500 
!     DUMMY VARIABLES.                                                             RAD_ALL.26501 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.26502 
     &     N_PROFILE                                                               RAD_ALL.26503 
!             NUMBER OF PROFILES                                                   RAD_ALL.26504 
     &   , I_LAYER_FIRST                                                           RAD_ALL.26505 
!             FIRST LAYER TO CONSIDER                                              RAD_ALL.26506 
     &   , I_LAYER_LAST                                                            RAD_ALL.26507 
!             LAST LAYER TO CONSIDER                                               RAD_ALL.26508 
!                                                                                  RAD_ALL.26509 
!     ALGORITHMIC CONTROL                                                          RAD_ALL.26510 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.26511 
     &     L_IR_SOURCE_QUAD                                                        RAD_ALL.26512 
!             QUADRATIC SOURCE IN INFRA-RED                                        RAD_ALL.26513 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.26514 
     &     ISOLIR                                                                  RAD_ALL.26515 
!             SPECTRAL REGION                                                      RAD_ALL.26516 
!                                                                                  RAD_ALL.26517 
!     OPTICAL PROPERTIES OF THE LAYER                                              RAD_ALL.26518 
      REAL      !, INTENT(IN)                                                      RAD_ALL.26519 
     &     TAU(NPD_PROFILE, NPD_LAYER)                                             RAD_ALL.26520 
!             OPTICAL DEPTHS OF LAYERS                                             RAD_ALL.26521 
     &   , SUM(NPD_PROFILE, NPD_LAYER)                                             RAD_ALL.26522 
!             SUM OF ALPHA_1 AND ALPHA_2                                           RAD_ALL.26523 
     &   , DIFF(NPD_PROFILE, NPD_LAYER)                                            RAD_ALL.26524 
!             DIFFERENCE OF ALPHA_1 AND ALPHA_2                                    RAD_ALL.26525 
     &   , LAMBDA(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.26526 
!             LAMBDA                                                               RAD_ALL.26527 
     &   , SEC_0(NPD_PROFILE)                                                      RAD_ALL.26528 
!             SECANT OF SOLAR ZENITH ANGLE                                         RAD_ALL.26529 
     &   , GAMMA_UP(NPD_PROFILE, NPD_LAYER)                                        RAD_ALL.26530 
!             BASIC SOLAR COEFFICIENT FOR UPWARD RADIATION                         RAD_ALL.26531 
     &   , GAMMA_DOWN(NPD_PROFILE, NPD_LAYER)                                      RAD_ALL.26532 
!             BASIC SOLAR COEFFICIENT FOR DOWNWARD RADIATION                       RAD_ALL.26533 
!                                                                                  RAD_ALL.26534 
!     TRANSMISSION AND REFLECTION COEFFICIENTS AND COEFFICIENTS FOR                RAD_ALL.26535 
!     SOURCE TERMS.                                                                RAD_ALL.26536 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.26537 
     &     TRANS(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.26538 
!             DIFFUSE TRANSMISSION COEFFICIENT                                     RAD_ALL.26539 
     &   , REFLECT(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.26540 
!             DIFFUSE REFLECTION COEFFICIENT                                       RAD_ALL.26541 
     &   , TRANS_0(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.26542 
!             DIRECT TRANSMISSION COEFFICIENT                                      RAD_ALL.26543 
     &   , SOURCE_COEFF(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)                  RAD_ALL.26544 
!             SOURCE COEFFICIENTS                                                  RAD_ALL.26545 
!                                                                                  RAD_ALL.26546 
!                                                                                  RAD_ALL.26547 
!     LOCAL VARIABLES                                                              RAD_ALL.26548 
      INTEGER                                                                      RAD_ALL.26549 
     &     I                                                                       RAD_ALL.26550 
!             LOOP VARIABLE                                                        RAD_ALL.26551 
     &   , L                                                                       RAD_ALL.26552 
!             LOOP VARIABLE                                                        RAD_ALL.26553 
      REAL                                                                         RAD_ALL.26554 
     &     GAMMA                                                                   RAD_ALL.26555 
!             GAMMA                                                                RAD_ALL.26556 
     &   , EXPONENTIAL                                                             RAD_ALL.26557 
!             EXPONENTIAL OF SCALED OPTICAL DEPTH                                  RAD_ALL.26558 
      REAL  XLAMTAU(N_PROFILE,I_LAYER_LAST-I_LAYER_FIRST+1) !Workspace             RAD_ALL.26559 
      INTEGER n_input     ! No. of inputs for exp_v                                RAD_ALL.26560 
!                                                                                  RAD_ALL.26561 
!                                                                                  RAD_ALL.26562 
!                                                                                  RAD_ALL.26563 
!                                                                                  RAD_ALL.26564 
!     DETERMINE THE DIFFUSE TRANSMISSION AND REFLECTION COEFFICIENTS.              RAD_ALL.26565 
!                                                                                  RAD_ALL.26566 
      DO I=I_LAYER_FIRST, I_LAYER_LAST                                             RAD_ALL.26567 
         DO L=1, N_PROFILE                                                         RAD_ALL.26568 
            XLAMTAU(L,I-I_LAYER_FIRST+1)=-LAMBDA(L,I)*TAU(L,I)                     RAD_ALL.26569 
         ENDDO                                                                     RAD_ALL.26570 
      ENDDO                                                                        RAD_ALL.26571 
      n_input=(I_LAYER_LAST-I_LAYER_FIRST+1)*N_PROFILE                             RAD_ALL.26572 
      do I=1,I_LAYER_LAST-I_LAYER_FIRST+1                                          RAD_ALL.26576 
        do L=1,n_profile                                                           RAD_ALL.26577 
          xlamtau(L,I)=exp(xlamtau(L,I))                                           RAD_ALL.26578 
        end do                                                                     RAD_ALL.26579 
      end do                                                                       RAD_ALL.26580 
!                                                                                  RAD_ALL.26582 
      DO I=I_LAYER_FIRST, I_LAYER_LAST                                             RAD_ALL.26583 
         DO L=1, N_PROFILE                                                         RAD_ALL.26584 
            EXPONENTIAL=xlamtau(L,I-I_LAYER_FIRST+1)                               RAD_ALL.26585 
            GAMMA=(SUM(L, I)-LAMBDA(L, I))                                         RAD_ALL.26586 
     &         /(SUM(L, I)+LAMBDA(L, I))                                           RAD_ALL.26587 
            TRANS(L, I)=(EXPONENTIAL*(1.0E+00-GAMMA**2)                            RAD_ALL.26588 
     &         /(1.0E+00-(EXPONENTIAL*GAMMA)**2))                                  RAD_ALL.26589 
            REFLECT(L, I)=GAMMA*(1.0E+00-EXPONENTIAL**2)                           RAD_ALL.26590 
     &         /(1.0E+00-(EXPONENTIAL*GAMMA)**2)                                   RAD_ALL.26591 
         ENDDO                                                                     RAD_ALL.26592 
      ENDDO                                                                        RAD_ALL.26593 
!                                                                                  RAD_ALL.26594 
!                                                                                  RAD_ALL.26595 
!                                                                                  RAD_ALL.26596 
      IF (ISOLIR.EQ.IP_SOLAR) THEN                                                 RAD_ALL.26597 
!                                                                                  RAD_ALL.26598 
!        CALCULATE THE DIRECT TRANSMISSION AND THE SOURCE COEFFICIENTS             RAD_ALL.26599 
!        FOR THE SOLAR BEAM: IN THE SOLAR CASE THESE ARE                           RAD_ALL.26600 
!        THE COEFFICIENTS WHICH WILL MULTIPLY THE DIRECT FLUX AT THE               RAD_ALL.26601 
!        TOP OF THE LAYER TO GIVE THE SOURCE TERMS FOR THE UPWARD                  RAD_ALL.26602 
!        DIFFUSE FLUX AND THE TOTAL DOWNWARD FLUX.                                 RAD_ALL.26603 
!                                                                                  RAD_ALL.26604 
         DO I=I_LAYER_FIRST, I_LAYER_LAST                                          RAD_ALL.26605 
            DO L=1, N_PROFILE                                                      RAD_ALL.26606 
               TRANS_0(L, I)=EXP(-TAU(L, I)*SEC_0(L))                              RAD_ALL.26607 
               SOURCE_COEFF(L, I, IP_SCF_SOLAR_UP)                                 RAD_ALL.26608 
     &            =(GAMMA_UP(L, I)-REFLECT(L, I)                                   RAD_ALL.26609 
     &            *(1.0E+00+GAMMA_DOWN(L, I)))                                     RAD_ALL.26610 
     &            -GAMMA_UP(L, I)*TRANS(L, I)*TRANS_0(L, I)                        RAD_ALL.26611 
               SOURCE_COEFF(L, I, IP_SCF_SOLAR_DOWN)=TRANS_0(L, I)                 RAD_ALL.26612 
     &            *(1.0E+00+GAMMA_DOWN(L, I)                                       RAD_ALL.26613 
     &            -GAMMA_UP(L, I)*REFLECT(L, I))                                   RAD_ALL.26614 
     &            -(1.0E+00+GAMMA_DOWN(L, I))*TRANS(L, I)                          RAD_ALL.26615 
            ENDDO                                                                  RAD_ALL.26616 
         ENDDO                                                                     RAD_ALL.26617 
!                                                                                  RAD_ALL.26618 
!                                                                                  RAD_ALL.26619 
      ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                        RAD_ALL.26620 
!                                                                                  RAD_ALL.26621 
!        IN THE CASE OF INFRA-RED RADIATION, THE FIRST SOURCE                      RAD_ALL.26622 
!        COEFFICIENT HOLDS THE MULTIPLIER FOR THE FIRST DIFFERENCE                 RAD_ALL.26623 
!        OF THE PLANCK FUNCTION ACROSS THE LAYER, AND THE SECOND                   RAD_ALL.26624 
!        THAT FOR THE SECOND DIFFERENCE.                                           RAD_ALL.26625 
!                                                                                  RAD_ALL.26626 
         DO I=I_LAYER_FIRST, I_LAYER_LAST                                          RAD_ALL.26627 
            DO L=1, N_PROFILE                                                      RAD_ALL.26628 
!                                                                                  RAD_ALL.26629 
!              A TOLERANCE IS ADDED TO THE NUMERATOR AND THE DENOMIATOR            RAD_ALL.26630 
!              TO AVOID ILL-CONDITIONING AT SMALL OPTICAL DEPTHS.                  RAD_ALL.26631 
!                                                                                  RAD_ALL.26632 
               SOURCE_COEFF(L, I, IP_SCF_IR_1D)=(1.0E+00-TRANS(L, I)               RAD_ALL.26633 
     &            +REFLECT(L, I)+SQRT_TOL_MACHINE)                                 RAD_ALL.26634 
     &            /(SQRT_TOL_MACHINE+TAU(L, I)*SUM(L, I))                          RAD_ALL.26635 
!                                                                                  RAD_ALL.26636 
            ENDDO                                                                  RAD_ALL.26637 
         ENDDO                                                                     RAD_ALL.26638 
!                                                                                  RAD_ALL.26639 
!                                                                                  RAD_ALL.26640 
         IF (L_IR_SOURCE_QUAD) THEN                                                RAD_ALL.26641 
!                                                                                  RAD_ALL.26642 
!           QUADRATIC CORRECTION TO SOURCE FUNCTION.                               RAD_ALL.26643 
!           THIS CORRECTION IS VERY ILL-CONDITIONED FOR                            RAD_ALL.26644 
!           SMALL OPTICAL DEPTHS SO THE ASYMPTOTIC FORM IS THEN USED.              RAD_ALL.26645 
!                                                                                  RAD_ALL.26646 
            DO I=I_LAYER_FIRST, I_LAYER_LAST                                       RAD_ALL.26647 
               DO L=1, N_PROFILE                                                   RAD_ALL.26648 
!                                                                                  RAD_ALL.26649 
!                 USE A SEPARATE ASYMPTOTIC FORM WHEN THE OPTICAL                  RAD_ALL.26650 
!                 DEPTH IS SMALL, MAKING THE TRANSITION WHEN THE                   RAD_ALL.26651 
!                 OPTICAL DEPTH IS ROUGHLY EQUAL TO THE CUBE ROOT                  RAD_ALL.26652 
!                 OF THE MACHINE'S PRECISION.                                      RAD_ALL.26653 
!                                                                                  RAD_ALL.26654 
                  IF (TAU(L, I).GT.EXP(3.3E-01*LOG(TOL_MACHINE))) THEN             RAD_ALL.26655 
                     SOURCE_COEFF(L, I, IP_SCF_IR_2D)                              RAD_ALL.26656 
     &                  =-2.0E+00*(1.0E+00-TRANS(L, I)-REFLECT(L, I)               RAD_ALL.26657 
     &                  +SQRT_TOL_MACHINE)                                         RAD_ALL.26658 
     &                  /(DIFF(L, I)*TAU(L, I)+SQRT_TOL_MACHINE)                   RAD_ALL.26659 
                  ELSE                                                             RAD_ALL.26660 
                     SOURCE_COEFF(L, I, IP_SCF_IR_2D)                              RAD_ALL.26661 
     &                  =-2.0E+00+DIFF(L, I)*TAU(L, I)                             RAD_ALL.26662 
                  ENDIF                                                            RAD_ALL.26663 
!                                                                                  RAD_ALL.26664 
                  SOURCE_COEFF(L, I, IP_SCF_IR_2D)                                 RAD_ALL.26665 
     &               =-(1.0E+00+REFLECT(L, I)+TRANS(L, I)                          RAD_ALL.26666 
     &               +SOURCE_COEFF(L, I, IP_SCF_IR_2D))                            RAD_ALL.26667 
     &               /(SUM(L, I)*TAU(L, I)+SQRT_TOL_MACHINE)                       RAD_ALL.26668 
!                                                                                  RAD_ALL.26669 
               ENDDO                                                               RAD_ALL.26670 
            ENDDO                                                                  RAD_ALL.26671 
!                                                                                  RAD_ALL.26672 
         ENDIF                                                                     RAD_ALL.26673 
!                                                                                  RAD_ALL.26674 
      ENDIF                                                                        RAD_ALL.26675 
!                                                                                  RAD_ALL.26676 
!                                                                                  RAD_ALL.26677 
!                                                                                  RAD_ALL.26678 
      RETURN                                                                       RAD_ALL.26679 
      END 
