SUBROUTINE TWO_COEFF(IERR 8,6TCF3A.22
& , N_PROFILE, I_LAYER_FIRST, I_LAYER_LAST TCF3A.23
& , I_2STREAM, L_IR_SOURCE_QUAD TCF3A.24
& , ASYMMETRY, OMEGA, TAU TCF3A.25
& , ISOLIR, SEC_0 TCF3A.26
& , TRANS, REFLECT, TRANS_0 TCF3A.27
& , SOURCE_COEFF TCF3A.28
& , NPD_PROFILE, NPD_LAYER TCF3A.29
& ) TCF3A.30
! TCF3A.31
! TCF3A.32
! TCF3A.33
IMPLICIT NONE TCF3A.34
! TCF3A.35
! TCF3A.36
! SIZES OF DUMMY ARRAYS. TCF3A.37
INTEGER !, INTENT(IN) TCF3A.38
& NPD_PROFILE TCF3A.39
! MAXIMUM NUMBER OF PROFILES TCF3A.40
& , NPD_LAYER TCF3A.41
! MAXIMUM NUMBER OF LAYERS TCF3A.42
! TCF3A.43
! INCLUDE COMDECKS. TCF3A.44
*CALL DIMFIX3A 
TCF3A.45
*CALL SPCRG3A TCF3A.46
*CALL PRMCH3A TCF3A.47
*CALL PRECSN3A TCF3A.48
*CALL ERROR3A TCF3A.49
! TCF3A.50
! TCF3A.51
! TCF3A.52
! DUMMY ARGUMENTS. TCF3A.53
INTEGER !, INTENT(OUT) TCF3A.54
& IERR TCF3A.55
! ERROR FLAG TCF3A.56
INTEGER !, INTENT(IN) TCF3A.57
& N_PROFILE TCF3A.58
! NUMBER OF PROFILES TCF3A.59
& , I_LAYER_FIRST TCF3A.60
! FIRST LAYER TO CONSIDER TCF3A.61
& , I_LAYER_LAST TCF3A.62
! LAST LAYER TO CONSIDER TCF3A.63
& , ISOLIR TCF3A.64
! SPECTRAL REGION TCF3A.65
& , I_2STREAM TCF3A.66
! TWO STREAM SCHEME TCF3A.67
LOGICAL !, INTENT(IN) TCF3A.68
& L_IR_SOURCE_QUAD TCF3A.69
! USE A QUADRATIC SOURCE FUNCTION TCF3A.70
! TCF3A.71
! OPTICAL PROPERTIES OF LAYER: TCF3A.72
REAL !, INTENT(IN) TCF3A.73
& ASYMMETRY(NPD_PROFILE, NPD_LAYER) TCF3A.74
! ASYMMETRY FACTOR TCF3A.75
& , OMEGA(NPD_PROFILE, NPD_LAYER) TCF3A.76
! ALBEDO OF SINGLE SCATTERING ADB1F401.1125
& , TAU(NPD_PROFILE, NPD_LAYER) TCF3A.78
! OPTICAL DEPTH TCF3A.79
! TCF3A.80
! SOLAR BEAM TCF3A.81
REAL !, INTENT(IN) TCF3A.82
& SEC_0(NPD_PROFILE) TCF3A.83
! SECANT OF ZENITH ANGLE TCF3A.84
! TCF3A.85
! TCF3A.86
! COEFFICIENTS IN THE TWO-STREAM EQUATIONS: TCF3A.87
REAL !, INTENT(OUT) TCF3A.88
& TRANS(NPD_PROFILE, NPD_LAYER) TCF3A.89
! DIFFUSE TRANSMISSION COEFFICIENT TCF3A.90
& , REFLECT(NPD_PROFILE, NPD_LAYER) TCF3A.91
! DIFFUSE REFLECTION COEFFICIENT TCF3A.92
& , TRANS_0(NPD_PROFILE, NPD_LAYER) TCF3A.93
! DIRECT TRANSMISSION COEFFICIENT TCF3A.94
& , SOURCE_COEFF(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF) TCF3A.95
! SOURCE COEFFICIENTS IN TWO-STREAM EQUATIONS TCF3A.96
! TCF3A.97
! TCF3A.98
! LOCAL VARIABLES. TCF3A.99
INTEGER TCF3A.100
& I TCF3A.101
! LOOP VARIABLE TCF3A.102
& , L TCF3A.103
! LOOP VARIABLE TCF3A.104
& , K TCF3A.105
! LOOP VARIABLE TCF3A.106
& , N_INDEX TCF3A.107
! NUMBER OF INDICES SATISFYING TEST TCF3A.108
& , INDEX(NPD_PROFILE) TCF3A.109
! INDICES OF TESTED POINTS TCF3A.110
! TCF3A.111
! COEFFICIENTS IN THE TWO-STREAM EQUATIONS: TCF3A.112
REAL TCF3A.113
& LAMBDA(NPD_PROFILE, NPD_LAYER) TCF3A.114
! COEFFICIENTS IN TWO-STREAM EQUATIONS TCF3A.115
& , SUM(NPD_PROFILE, NPD_LAYER) TCF3A.116
! SUM OF ALPHA_1 AND ALPHA_2 TCF3A.117
& , DIFF(NPD_PROFILE, NPD_LAYER) TCF3A.118
! DIFFERENCE OF ALPHA_1 AND ALPHA_2 TCF3A.119
& , GAMMA_UP(NPD_PROFILE, NPD_LAYER) TCF3A.120
! BASIC SOLAR COEFFICIENT FOR UPWARD RADIATION TCF3A.121
& , GAMMA_DOWN(NPD_PROFILE, NPD_LAYER) TCF3A.122
! BASIC SOLAR COEFFICIENT FOR DOWNWARD RADIATION TCF3A.123
! TCF3A.124
REAL TCF3A.125
& TARGET TCF3A.126
! TARGET TO SEARCH FOR TCF3A.127
! TCF3A.128
! TCF3A.129
! SUBROUTINES CALLED: TCF3A.130
EXTERNAL TCF3A.131
& TWO_COEFF_BASIC, SOLAR_COEFFICIENT_BASIC GSS1F403.55
& , TRANS_SOURCE_COEFF TCF3A.133
! TCF3A.134
! CRAY DIRECTIVES FOR THE WHOLE ROUTINE: ADB1F402.747
! POINTS ARE NOT REPEATED IN THE INDEXING ARRAY, SO IT IS SAFE ADB1F402.748
! TO VECTORIZE OVER INDIRECTLY ADDRESSED ARRAYS. ADB1F402.749
Cfpp$ NODEPCHK R ADB1F402.750
! ADB1F402.751
! TCF3A.135
! TCF3A.136
! PERTURB THE SINGLE SCATTERING ALBEDO AWAY FROM 1 TO AVOID TCF3A.137
! LATER DIVISION BY 0. TCF3A.138
TARGET=1.0E+00-TOL_DIV TCF3A.139
DO I=I_LAYER_FIRST, I_LAYER_LAST TCF3A.140
! GSS2F402.68
N_INDEX=0 GSS2F402.69
DO L =1,N_PROFILE GSS2F402.70
IF (OMEGA(L,I).GT.TARGET) THEN GSS2F402.71
N_INDEX =N_INDEX+1 GSS2F402.72
INDEX(N_INDEX)=L GSS2F402.73
END IF GSS2F402.74
END DO GSS2F402.75
! GSS2F402.76
DO K=1, N_INDEX TCF3A.143
OMEGA(INDEX(K), I)=TARGET TCF3A.144
ENDDO TCF3A.145
ENDDO TCF3A.146
! TCF3A.147
! CALCULATE THE BASIC TWO-STREAM COEFFICIENTS. TCF3A.148
CALL TWO_COEFF_BASIC(IERR TCF3A.149
& , N_PROFILE, I_LAYER_FIRST, I_LAYER_LAST TCF3A.150
& , I_2STREAM TCF3A.151
& , ASYMMETRY, OMEGA TCF3A.152
& , SUM, DIFF TCF3A.153
& , NPD_PROFILE, NPD_LAYER TCF3A.154
& ) TCF3A.155
IF (IERR.NE.I_NORMAL) THEN TCF3A.156
RETURN TCF3A.157
ENDIF TCF3A.158
! TCF3A.159
! LAMBDA IS NOW CALCULATED. TCF3A.160
DO I=I_LAYER_FIRST, I_LAYER_LAST TCF3A.161
DO L=1, N_PROFILE TCF3A.162
LAMBDA(L, I)=SQRT(SUM(L, I)*DIFF(L, I)) TCF3A.163
ENDDO TCF3A.164
ENDDO TCF3A.165
! TCF3A.166
! TCF3A.167
! CALCULATE THE BASIC COEFFICIENTS FOR THE SOLAR SOURCE TERMS. TCF3A.168
IF (ISOLIR.EQ.IP_SOLAR) THEN TCF3A.169
! LAMBDA MAY BE PERTURBED BY THIS ROUTINE TO AVOID TCF3A.170
! ILL-CONDITIONING FOR THE SINGULAR ZENITH ANGLE. TCF3A.171
CALL SOLAR_COEFFICIENT_BASIC(IERR TCF3A.172
& , N_PROFILE, I_LAYER_FIRST, I_LAYER_LAST TCF3A.173
& , OMEGA, ASYMMETRY, SEC_0 TCF3A.174
& , I_2STREAM TCF3A.175
& , SUM, DIFF, LAMBDA TCF3A.176
& , GAMMA_UP, GAMMA_DOWN TCF3A.177
& , NPD_PROFILE, NPD_LAYER TCF3A.178
& ) TCF3A.179
IF (IERR.NE.I_NORMAL) RETURN TCF3A.180
ENDIF TCF3A.181
! TCF3A.182
! TCF3A.183
! DETERMINE THE TRANSMISSION AND REFLECTION COEFFICIENTS. TCF3A.184
CALL TRANS_SOURCE_COEFF(N_PROFILE, I_LAYER_FIRST, I_LAYER_LAST TCF3A.185
& , ISOLIR, L_IR_SOURCE_QUAD TCF3A.186
& , TAU, SUM, DIFF, LAMBDA, SEC_0 TCF3A.187
& , GAMMA_UP, GAMMA_DOWN TCF3A.188
& , TRANS, REFLECT, TRANS_0, SOURCE_COEFF TCF3A.189
& , NPD_PROFILE, NPD_LAYER TCF3A.190
& ) TCF3A.191
! TCF3A.192
! TCF3A.193
! TCF3A.194
RETURN TCF3A.195
END TCF3A.196
*ENDIF DEF,A01_3A,OR,DEF,A02_3A TCF3A.197
*ENDIF DEF,A70_1A ADB1F402.132