*IF DEF,A70_1A,OR,DEF,A70_1B                                               APB4F405.99     
*IF DEF,A01_3A,OR,DEF,A02_3A                                               SNSCF3A.2      
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.13943  
C                                                                          GTS2F400.13944  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.13945  
C restrictions as set forth in the contract.                               GTS2F400.13946  
C                                                                          GTS2F400.13947  
C                Meteorological Office                                     GTS2F400.13948  
C                London Road                                               GTS2F400.13949  
C                BRACKNELL                                                 GTS2F400.13950  
C                Berkshire UK                                              GTS2F400.13951  
C                RG12 2SZ                                                  GTS2F400.13952  
C                                                                          GTS2F400.13953  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.13954  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.13955  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.13956  
C Modelling at the above address.                                          GTS2F400.13957  
C ******************************COPYRIGHT******************************    GTS2F400.13958  
C                                                                          GTS2F400.13959  
!+ Function to set number of source coefficients.                          SNSCF3A.3      
!                                                                          SNSCF3A.4      
! Method:                                                                  SNSCF3A.5      
!       The two-stream approximation is examined and the number            SNSCF3A.6      
!       of coefficients is set accordingly.                                SNSCF3A.7      
!                                                                          SNSCF3A.8      
! Current Owner of Code: J. M. Edwards                                     SNSCF3A.9      
!                                                                          SNSCF3A.10     
! History:                                                                 SNSCF3A.11     
!       Version         Date                    Comment                    SNSCF3A.12     
!       4.0             27-07-95                Original Code              SNSCF3A.13     
!                                               (J. M. Edwards)            SNSCF3A.14     
!                                               (J. M. Edwards)            SNSCF3A.15     
!                                                                          SNSCF3A.16     
! Description of Code:                                                     SNSCF3A.17     
!   FORTRAN 77 with extensions listed in documentation.                    SNSCF3A.18     
!                                                                          SNSCF3A.19     
!- ---------------------------------------------------------------------   SNSCF3A.20     

      FUNCTION SET_N_SOURCE_COEFF(ISOLIR, L_IR_SOURCE_QUAD                  3SNSCF3A.21     
     &   )                                                                 SNSCF3A.22     
!                                                                          SNSCF3A.23     
!                                                                          SNSCF3A.24     
!                                                                          SNSCF3A.25     
      IMPLICIT NONE                                                        SNSCF3A.26     
!                                                                          SNSCF3A.27     
!                                                                          SNSCF3A.28     
!     INCLUDE COMDECKS                                                     SNSCF3A.29     
*CALL SPCRG3A                                                              SNSCF3A.30     
!                                                                          SNSCF3A.31     
!     DUMMY ARGUMENTS.                                                     SNSCF3A.32     
      INTEGER   !, INTENT(IN)                                              SNSCF3A.33     
     &     ISOLIR                                                          SNSCF3A.34     
!             SPECTRAL REGION                                              SNSCF3A.35     
      LOGICAL   !, INTENT(IN)                                              SNSCF3A.36     
     &     L_IR_SOURCE_QUAD                                                SNSCF3A.37     
!             FLAG FOR QUADRATIC INFRA-RED SOURCE                          SNSCF3A.38     
!                                                                          SNSCF3A.39     
      INTEGER   !, INTENT(OUT)                                             SNSCF3A.40     
     &     SET_N_SOURCE_COEFF                                              SNSCF3A.41     
!             RETURNED NUMBER OF SOURCE COEFFICIENTS                       SNSCF3A.42     
!                                                                          SNSCF3A.43     
!                                                                          SNSCF3A.44     
!                                                                          SNSCF3A.45     
      IF (ISOLIR.EQ.IP_SOLAR) THEN                                         SNSCF3A.46     
         SET_N_SOURCE_COEFF=2                                              SNSCF3A.47     
      ELSE                                                                 SNSCF3A.48     
         IF (L_IR_SOURCE_QUAD) THEN                                        SNSCF3A.49     
            SET_N_SOURCE_COEFF=2                                           SNSCF3A.50     
         ELSE                                                              SNSCF3A.51     
            SET_N_SOURCE_COEFF=1                                           SNSCF3A.52     
         ENDIF                                                             SNSCF3A.53     
      ENDIF                                                                SNSCF3A.54     
!                                                                          SNSCF3A.55     
!                                                                          SNSCF3A.56     
!                                                                          SNSCF3A.57     
      RETURN                                                               SNSCF3A.58     
      END                                                                  SNSCF3A.59     
*ENDIF DEF,A01_3A,OR,DEF,A02_3A                                            SNSCF3A.60     
*ENDIF DEF,A70_1A,OR,DEF,A70_1B                                            APB4F405.100