SUBROUTINE SINGLE_SCATTERING(I_SCATTER_METHOD_BAND 2SSCT3A.21
& , N_PROFILE, N_LAYER, I_TOP SSCT3A.22
& , D_MASS SSCT3A.23
& , K_GREY_TOT, K_EXT_SCAT, K_GAS_ABS SSCT3A.24
& , TAU, OMEGA SSCT3A.25
& , NPD_PROFILE, NPD_LAYER SSCT3A.26
& ) SSCT3A.27
! SSCT3A.28
! SSCT3A.29
! SSCT3A.30
IMPLICIT NONE SSCT3A.31
! SSCT3A.32
! SSCT3A.33
! SIZES OF ARRAYS. SSCT3A.34
INTEGER !, INTENT(IN) SSCT3A.35
& NPD_PROFILE SSCT3A.36
! MAXIMUM NUMBER OF PROFILES SSCT3A.37
& , NPD_LAYER SSCT3A.38
! MAXIMUM NUMBER OF LAYERS SSCT3A.39
! SSCT3A.40
! INCLUDE COMDECKS. SSCT3A.41
*CALL PRMCH3A 
SSCT3A.42
*CALL SCTMTH3A SSCT3A.43
! SSCT3A.44
! DUMMY VARIABLES. SSCT3A.45
INTEGER !, INTENT(IN) SSCT3A.46
& I_SCATTER_METHOD_BAND SSCT3A.47
! TREATMENT OF SCATTERING IN THIS BAND SSCT3A.48
! SSCT3A.49
! Atmospheric Properties SSCT3A.50
INTEGER !, INTENT(IN) SSCT3A.51
& N_PROFILE SSCT3A.52
! NUMBER OF PROFILES SSCT3A.53
& , N_LAYER SSCT3A.54
! NUMBER OF LAYERS SSCT3A.55
& , I_TOP SSCT3A.56
! TOP LAYER TO CONSIDER SSCT3A.57
REAL !, INTENT(IN) SSCT3A.58
& D_MASS(NPD_PROFILE, NPD_LAYER) SSCT3A.59
! MASS THICKNESS OF EACH LAYER SSCT3A.60
! SSCT3A.61
! Optical Propeties SSCT3A.62
REAL !, INTENT(IN) SSCT3A.63
& K_GREY_TOT(NPD_PROFILE, NPD_LAYER) SSCT3A.64
! ABSORPTIVE EXTINCTION SSCT3A.65
& , K_EXT_SCAT(NPD_PROFILE, NPD_LAYER) SSCT3A.66
! SCATTERING EXTINCTION SSCT3A.67
& , K_GAS_ABS(NPD_PROFILE, NPD_LAYER) SSCT3A.68
! GASEOUS EXTINCTION SSCT3A.69
! SSCT3A.70
! Single Scattering Propeties SSCT3A.71
REAL !, INTENT(OUT) SSCT3A.72
& TAU(NPD_PROFILE, NPD_LAYER) SSCT3A.73
! OPTICAL DEPTH SSCT3A.74
& , OMEGA(NPD_PROFILE, NPD_LAYER) SSCT3A.75
! SINGLE SCATTERING ALBEDO SSCT3A.76
! SSCT3A.77
! SSCT3A.78
! SSCT3A.79
! LOCAL VARIABLES. SSCT3A.80
INTEGER SSCT3A.81
& L SSCT3A.82
! LOOP VARIABLE SSCT3A.83
& , I SSCT3A.84
! LOOP VARIABLE SSCT3A.85
! SSCT3A.86
! SSCT3A.87
! SSCT3A.88
! THE MACHINE TOLERANCE IS ADDED TO THE DENOMINATOR IN THE SSCT3A.89
! EXPRESSION FOR OMEGA TO PREVENT DIVISION BY ZERO: THIS IS SSCT3A.90
! SIGNIFICANT ONLY IF THE TOTAL EXTINCTION IS SMALL, AND THUS SSCT3A.91
! WILL NOT SENSIBLY AFFECT ANY PHYSICAL RESULTS. SSCT3A.92
! SSCT3A.93
IF (I_SCATTER_METHOD_BAND.EQ.IP_SCATTER_FULL) THEN SSCT3A.94
! SSCT3A.95
DO I=I_TOP, N_LAYER SSCT3A.96
DO L=1, N_PROFILE SSCT3A.97
TAU(L, I)=(K_GREY_TOT(L, I)+K_GAS_ABS(L, I)) SSCT3A.98
& *D_MASS(L, I) SSCT3A.99
OMEGA(L, I)=K_EXT_SCAT(L, I) SSCT3A.100
& /(K_GREY_TOT(L, I)+K_GAS_ABS(L, I)+TOL_MACHINE) SSCT3A.101
ENDDO SSCT3A.102
ENDDO SSCT3A.103
! SSCT3A.104
ELSE IF (I_SCATTER_METHOD_BAND.EQ.IP_NO_SCATTER_ABS) THEN SSCT3A.105
! SSCT3A.106
! THE SCATTERING EXTINCTION IS IGNORED COMPLETELY, SO SSCT3A.107
! ONLY THE ABSORPTIVE CONTRIBUTIONS TO THE SINGLE SSCT3A.108
! SCATTERING PROPETIES ARE INCLUDED. SSCT3A.109
! SSCT3A.110
DO I=I_TOP, N_LAYER SSCT3A.111
DO L=1, N_PROFILE SSCT3A.112
TAU(L, I)=(K_GREY_TOT(L, I)+K_GAS_ABS(L, I) SSCT3A.113
& -K_EXT_SCAT(L, I))*D_MASS(L, I) SSCT3A.114
OMEGA(L, I)=0.0 SSCT3A.115
ENDDO SSCT3A.116
ENDDO SSCT3A.117
! SSCT3A.118
ELSE IF (I_SCATTER_METHOD_BAND.EQ.IP_NO_SCATTER_EXT) THEN SSCT3A.119
! SSCT3A.120
! THE SCATTERING EXTINCTION IS ADDED ON TO THE ABSORPTION. SSCT3A.121
! SSCT3A.122
DO I=I_TOP, N_LAYER SSCT3A.123
DO L=1, N_PROFILE SSCT3A.124
TAU(L, I)=(K_GREY_TOT(L, I)+K_GAS_ABS(L, I)) SSCT3A.125
& *D_MASS(L, I) SSCT3A.126
OMEGA(L, I)=0.0E+00 SSCT3A.127
ENDDO SSCT3A.128
ENDDO SSCT3A.129
! SSCT3A.130
ENDIF SSCT3A.131
! SSCT3A.132
! SSCT3A.133
! SSCT3A.134
RETURN SSCT3A.135
END SSCT3A.136
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SSCT3A.137
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.110