*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.115
*IF DEF,A01_3A,OR,DEF,A02_3A STSCT3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.14096
C GTS2F400.14097
C Use, duplication or disclosure of this code is subject to the GTS2F400.14098
C restrictions as set forth in the contract. GTS2F400.14099
C GTS2F400.14100
C Meteorological Office GTS2F400.14101
C London Road GTS2F400.14102
C BRACKNELL GTS2F400.14103
C Berkshire UK GTS2F400.14104
C RG12 2SZ GTS2F400.14105
C GTS2F400.14106
C If no contract has been raised with this copy of the code, the use, GTS2F400.14107
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.14108
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.14109
C Modelling at the above address. GTS2F400.14110
C ******************************COPYRIGHT****************************** GTS2F400.14111
C GTS2F400.14112
!+ Subroutine to set the scattering flag in this a band. STSCT3A.3
! STSCT3A.4
! Method: STSCT3A.5
! Straightforward. STSCT3A.6
! STSCT3A.7
! Current Owner of Code: J. M. Edwards STSCT3A.8
! STSCT3A.9
! History: STSCT3A.10
! Version Date Comment STSCT3A.11
! 4.0 27-07-95 Original Code STSCT3A.12
! (J. M. Edwards) STSCT3A.13
! (J. M. Edwards) STSCT3A.14
! STSCT3A.15
! Description of Code: STSCT3A.16
! FORTRAN 77 with extensions listed in documentation. STSCT3A.17
! STSCT3A.18
!- --------------------------------------------------------------------- STSCT3A.19
SUBROUTINE SET_SCATTERING(I_SCATTER_METHOD 1STSCT3A.20
& , L_SWITCH_SCATTER STSCT3A.21
& , I_SCATTER_METHOD_BAND STSCT3A.22
& ) STSCT3A.23
! STSCT3A.24
! STSCT3A.25
! STSCT3A.26
IMPLICIT NONE STSCT3A.27
! STSCT3A.28
! STSCT3A.29
! STSCT3A.30
! INCLUDE COMDECKS STSCT3A.31
*CALL SCTMTH3A 
STSCT3A.32
! STSCT3A.33
! STSCT3A.34
! DUMMY ARGUMENTS. STSCT3A.35
INTEGER !, INTENT(IN) STSCT3A.36
& I_SCATTER_METHOD STSCT3A.37
! METHOD OF TREATING SCATTERING STSCT3A.38
LOGICAL !, INTENT(IN) STSCT3A.39
& L_SWITCH_SCATTER STSCT3A.40
! SCATTERING SWITCH FOR THE BAND STSCT3A.41
INTEGER !, INTENT(OUT) STSCT3A.42
& I_SCATTER_METHOD_BAND STSCT3A.43
! SCATTERING FLAG IN THIS BAND STSCT3A.44
! STSCT3A.45
! STSCT3A.46
! STSCT3A.47
IF (I_SCATTER_METHOD.EQ.IP_SCATTER_FULL) THEN STSCT3A.48
! STSCT3A.49
! PERFORM A FULL SCATTERING CALCULATION IN THIS BAND STSCT3A.50
I_SCATTER_METHOD_BAND=IP_SCATTER_FULL STSCT3A.51
! STSCT3A.52
ELSE IF (I_SCATTER_METHOD.EQ.IP_NO_SCATTER_ABS) THEN STSCT3A.53
! STSCT3A.54
! SCATTERING EXTINCTION IS TO BE NEGLECTED IF SPECIFIED IN THIS STSCT3A.55
! BAND. OTHERWISE A FULL SCATTERING CALCULATION IS REQUIRED. STSCT3A.56
IF (L_SWITCH_SCATTER) THEN STSCT3A.57
I_SCATTER_METHOD_BAND=IP_NO_SCATTER_ABS STSCT3A.58
ELSE STSCT3A.59
I_SCATTER_METHOD_BAND=IP_SCATTER_FULL STSCT3A.60
ENDIF STSCT3A.61
! STSCT3A.62
ELSE IF (I_SCATTER_METHOD.EQ.IP_NO_SCATTER_EXT) THEN STSCT3A.63
! STSCT3A.64
! SCATTERING EXTINCTION IS TO BE TREATED AS ABSORPTION IF STSCT3A.65
! SPECIFIED IN THIS BAND. OTHERWISE A FULL SCATTERING STSCT3A.66
! CALCULATION IS REQUIRED. STSCT3A.67
IF (L_SWITCH_SCATTER) THEN STSCT3A.68
I_SCATTER_METHOD_BAND=IP_NO_SCATTER_ABS STSCT3A.69
ELSE STSCT3A.70
I_SCATTER_METHOD_BAND=IP_SCATTER_FULL STSCT3A.71
ENDIF STSCT3A.72
! STSCT3A.73
ENDIF STSCT3A.74
! STSCT3A.75
! STSCT3A.76
! STSCT3A.77
RETURN STSCT3A.78
END STSCT3A.79
*ENDIF DEF,A01_3A,OR,DEF,A02_3A STSCT3A.80
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.116