SUBROUTINE TWO_COEFF_BASIC(IERR 2TCFB3A.20
& , N_PROFILE, I_LAYER_FIRST, I_LAYER_LAST TCFB3A.21
& , I_2STREAM TCFB3A.22
& , ASYMMETRY, OMEGA TCFB3A.23
& , SUM, DIFF TCFB3A.24
& , NPD_PROFILE, NPD_LAYER TCFB3A.25
& ) TCFB3A.26
! TCFB3A.27
! TCFB3A.28
! TCFB3A.29
IMPLICIT NONE TCFB3A.30
! TCFB3A.31
! TCFB3A.32
! SIZES OF DUMMY ARRAYS. TCFB3A.33
INTEGER !, INTENT(IN) TCFB3A.34
& NPD_PROFILE TCFB3A.35
! MAXIMUM NUMBER OF PROFILES TCFB3A.36
& , NPD_LAYER TCFB3A.37
! MAXIMUM NUMBER OF LAYERS TCFB3A.38
! TCFB3A.39
! INCLUDE COMDECKS. TCFB3A.40
*CALL STDIO3A 
TCFB3A.41
*CALL TWOSTR3A TCFB3A.42
*CALL ELSASS3A TCFB3A.43
*CALL ERROR3A TCFB3A.44
! TCFB3A.45
! TCFB3A.46
! TCFB3A.47
! DUMMY ARGUMENTS. TCFB3A.48
INTEGER !, INTENT(OUT) TCFB3A.49
& IERR TCFB3A.50
! ERROR FLAG TCFB3A.51
INTEGER !, INTENT(IN) TCFB3A.52
& N_PROFILE TCFB3A.53
! NUMBER OF PROFILES TCFB3A.54
& , I_LAYER_FIRST TCFB3A.55
! FIRST LAYER TO CONSIDER TCFB3A.56
& , I_LAYER_LAST TCFB3A.57
! LAST LAYER TO CONSIDER TCFB3A.58
& , I_2STREAM TCFB3A.59
! TWO STREAM SCHEME TCFB3A.60
! TCFB3A.61
! OPTICAL PROPERTIES OF LAYER: TCFB3A.62
REAL !, INTENT(IN) TCFB3A.63
& ASYMMETRY(NPD_PROFILE, NPD_LAYER) TCFB3A.64
! ASYMMETRY FACTOR TCFB3A.65
& , OMEGA(NPD_PROFILE, NPD_LAYER) TCFB3A.66
! ALBEDO OF SINGLE SCATTERING TCFB3A.67
! TCFB3A.68
! TCFB3A.69
! COEFFICIENTS IN THE TWO-STREAM EQUATIONS: TCFB3A.70
REAL !, INTENT(OUT) TCFB3A.71
& SUM(NPD_PROFILE, NPD_LAYER) TCFB3A.72
! SUM OF ALPHA_1 AND ALPHA_2 TCFB3A.73
& , DIFF(NPD_PROFILE, NPD_LAYER) TCFB3A.74
! DIFFERENCE OF ALPHA_1 AND ALPHA_2 TCFB3A.75
! TCFB3A.76
! LOCAL VARIABLES. TCFB3A.77
INTEGER TCFB3A.78
& I TCFB3A.79
! LOOP VARIABLE TCFB3A.80
& , L TCFB3A.81
! LOOP VARIABLE TCFB3A.82
! TCFB3A.83
REAL TCFB3A.84
& ROOT_3 TCFB3A.85
! SQUARE ROOT OF 3 TCFB3A.86
! TCFB3A.87
! TCFB3A.88
PARAMETER( TCFB3A.89
& ROOT_3=1.7320508075688772E+00 TCFB3A.90
& ) TCFB3A.91
! TCFB3A.92
! TCFB3A.93
! TCFB3A.94
! TCFB3A.95
IF (I_2STREAM.EQ.IP_EDDINGTON) THEN TCFB3A.96
DO I=I_LAYER_FIRST, I_LAYER_LAST TCFB3A.97
DO L=1, N_PROFILE TCFB3A.98
SUM(L, I)=1.5E+00*(1.0E+00 TCFB3A.99
& -OMEGA(L, I)*ASYMMETRY(L, I)) TCFB3A.100
DIFF(L, I)=2.0E+00*(1.0E+00-OMEGA(L, I)) TCFB3A.101
ENDDO TCFB3A.102
ENDDO TCFB3A.103
! TCFB3A.104
ELSE IF (I_2STREAM.EQ.IP_ELSASSER) THEN TCFB3A.105
DO I=I_LAYER_FIRST, I_LAYER_LAST TCFB3A.106
DO L=1, N_PROFILE TCFB3A.107
SUM(L, I)=ELSASSER_FACTOR TCFB3A.108
& -1.5E+00*OMEGA(L, I)*ASYMMETRY(L, I) TCFB3A.109
DIFF(L, I)=ELSASSER_FACTOR*(1.0E+00-OMEGA(L, I)) TCFB3A.110
ENDDO TCFB3A.111
ENDDO TCFB3A.112
! TCFB3A.113
ELSE IF (I_2STREAM.EQ.IP_DISCRETE_ORD) THEN TCFB3A.114
DO I=I_LAYER_FIRST, I_LAYER_LAST TCFB3A.115
DO L=1, N_PROFILE TCFB3A.116
SUM(L, I)=ROOT_3*(1.0E+00 TCFB3A.117
& -OMEGA(L, I)*ASYMMETRY(L, I)) TCFB3A.118
DIFF(L, I)=ROOT_3*(1.0E+00-OMEGA(L, I)) TCFB3A.119
ENDDO TCFB3A.120
ENDDO TCFB3A.121
! TCFB3A.122
ELSE IF (I_2STREAM.EQ.IP_PIFM85) THEN ADB1F401.1126
DO I=I_LAYER_FIRST, I_LAYER_LAST TCFB3A.124
DO L=1, N_PROFILE TCFB3A.125
SUM(L, I)=2.0E+00 TCFB3A.126
& -1.5E+00*OMEGA(L, I)*ASYMMETRY(L, I) TCFB3A.127
DIFF(L, I)=2.0E+00*(1.0E+00-OMEGA(L, I)) TCFB3A.128
ENDDO TCFB3A.129
ENDDO TCFB3A.130
! TCFB3A.131
ELSE IF (I_2STREAM.EQ.IP_2S_TEST) THEN TCFB3A.132
DO I=I_LAYER_FIRST, I_LAYER_LAST TCFB3A.133
DO L=1, N_PROFILE TCFB3A.134
SUM(L, I)=1.5E+00 TCFB3A.135
& -1.5E+00*OMEGA(L, I)*ASYMMETRY(L, I) TCFB3A.136
DIFF(L, I)=1.5E+00*(1.0E+00-OMEGA(L, I)) TCFB3A.137
ENDDO TCFB3A.138
ENDDO TCFB3A.139
! TCFB3A.140
ELSE IF (I_2STREAM.EQ.IP_HEMI_MEAN) THEN TCFB3A.141
DO I=I_LAYER_FIRST, I_LAYER_LAST TCFB3A.142
DO L=1, N_PROFILE TCFB3A.143
SUM(L, I)=2.0E+00 TCFB3A.144
& *(1.0E+00-OMEGA(L, I)*ASYMMETRY(L, I)) TCFB3A.145
DIFF(L, I)=2.0E+00*(1.0E+00-OMEGA(L, I)) TCFB3A.146
ENDDO TCFB3A.147
ENDDO TCFB3A.148
! TCFB3A.149
ELSE IF (I_2STREAM.EQ.IP_PIFM80) THEN ADB1F402.756
DO I=I_LAYER_FIRST, I_LAYER_LAST ADB1F402.757
DO L=1, N_PROFILE ADB1F402.758
SUM(L, I)=2.0E+00 ADB1F402.759
& -1.5E+00*OMEGA(L, I)*ASYMMETRY(L, I) ADB1F402.760
& -0.5E+00*OMEGA(L, I) ADB1F402.761
DIFF(L, I)=2.0E+00*(1.0E+00-OMEGA(L, I)) ADB1F402.762
ENDDO ADB1F402.763
ENDDO ADB1F402.764
! ADB1F402.765
ELSE IF (I_2STREAM.EQ.IP_IFM) THEN TCFB3A.150
WRITE(IU_ERR, '(/A)') TCFB3A.151
& '*** ERROR: THE IMPROVED FLUX METHOD HAS ' TCFB3A.152
& //'NOT BEEN IMPLEMENTED.' TCFB3A.153
IERR=I_ERR_FATAL TCFB3A.154
RETURN TCFB3A.155
! TCFB3A.156
ELSE IF (I_2STREAM.EQ.IP_ZDK_FLUX) THEN TCFB3A.157
WRITE(IU_ERR, '(/A)') TCFB3A.158
& '*** ERROR: ZDUNKOWSKI''S FLUX METHOD HAS ' TCFB3A.159
& //'NOT BEEN IMPLEMENTED.' TCFB3A.160
IERR=I_ERR_FATAL TCFB3A.161
RETURN TCFB3A.162
! TCFB3A.163
ELSE IF (I_2STREAM.EQ.IP_KRSCHG_FLUX) THEN TCFB3A.164
WRITE(IU_ERR, '(/A)') TCFB3A.165
& '*** ERROR: KERSCHGEN''S FLUX METHOD HAS ' TCFB3A.166
& //'NOT BEEN IMPLEMENTED.' TCFB3A.167
IERR=I_ERR_FATAL TCFB3A.168
RETURN TCFB3A.169
! TCFB3A.170
ELSE IF (I_2STREAM.EQ.IP_COAKLEY_CHYLEK_1) THEN TCFB3A.171
WRITE(IU_ERR, '(/A)') TCFB3A.172
& '*** ERROR: COAKLEY-CHYLEK''S FIRST METHOD HAS ' TCFB3A.173
& //'NOT BEEN IMPLEMENTED.' TCFB3A.174
IERR=I_ERR_FATAL TCFB3A.175
RETURN TCFB3A.176
! TCFB3A.177
ELSE IF (I_2STREAM.EQ.IP_COAKLEY_CHYLEK_2) THEN TCFB3A.178
WRITE(IU_ERR, '(/A)') TCFB3A.179
& '*** ERROR: COAKLEY-CHYLEK''S SECOND METHOD HAS ' TCFB3A.180
& //'NOT BEEN IMPLEMENTED.' TCFB3A.181
IERR=I_ERR_FATAL TCFB3A.182
RETURN TCFB3A.183
! TCFB3A.184
ELSE IF (I_2STREAM.EQ.IP_MEADOR_WEAVER) THEN TCFB3A.185
WRITE(IU_ERR, '(/A)') TCFB3A.186
& '*** ERROR: MEADOR & WEAVER''S METHOD HAS ' TCFB3A.187
& //'NOT BEEN IMPLEMENTED.' TCFB3A.188
IERR=I_ERR_FATAL TCFB3A.189
RETURN TCFB3A.190
! TCFB3A.191
ELSE TCFB3A.192
WRITE(IU_ERR, '(/A)') TCFB3A.193
& '*** ERROR: AN ILLEGAL PARAMETER HAS BEEN SUPPLIED ' TCFB3A.194
& //'TO DEFINE THE 2-STREAM SCHEME.' TCFB3A.195
IERR=I_ERR_FATAL TCFB3A.196
RETURN TCFB3A.197
! TCFB3A.198
ENDIF TCFB3A.199
! TCFB3A.200
! TCFB3A.201
! TCFB3A.202
RETURN TCFB3A.203
END TCFB3A.204
*ENDIF DEF,A01_3A,OR,DEF,A02_3A TCFB3A.205
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.120