SUBROUTINE MIXED_SOLAR_SOURCE(N_PROFILE, N_LAYER, N_CLOUD_TOP 1MXSSR3A.21
& , FLUX_INC_DIRECT MXSSR3A.22
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE MXSSR3A.23
& , TRANS_0_FREE, SOURCE_COEFF_FREE MXSSR3A.24
& , G_FF, G_FC, G_CF, G_CC MXSSR3A.25
& , TRANS_0_CLOUD, SOURCE_COEFF_CLOUD MXSSR3A.26
& , FLUX_DIRECT MXSSR3A.27
& , FLUX_DIRECT_GROUND_CLOUD ADB1F401.678
& , S_UP_FREE, S_DOWN_FREE MXSSR3A.28
& , S_UP_CLOUD, S_DOWN_CLOUD MXSSR3A.29
& , NPD_PROFILE, NPD_LAYER MXSSR3A.30
& ) MXSSR3A.31
! MXSSR3A.32
! MXSSR3A.33
! MXSSR3A.34
IMPLICIT NONE MXSSR3A.35
! MXSSR3A.36
! MXSSR3A.37
! SIZES OF DUMMY ARRAYS MXSSR3A.38
INTEGER !, INTENT(IN) MXSSR3A.39
& NPD_PROFILE MXSSR3A.40
! MAXIMUM NUMBER OF PROFILES MXSSR3A.41
& , NPD_LAYER MXSSR3A.42
! MAXIMUM NUMBER OF LAYERS MXSSR3A.43
! MXSSR3A.44
! COMDECKS INCLUDED MXSSR3A.45
*CALL DIMFIX3A 
MXSSR3A.46
*CALL SCFPT3A MXSSR3A.47
! MXSSR3A.48
! MXSSR3A.49
! MXSSR3A.50
! DUMMY ARGUMENTS. MXSSR3A.51
INTEGER !, INTENT(IN) MXSSR3A.52
& N_PROFILE MXSSR3A.53
! NUMBER OF PROFILES MXSSR3A.54
& , N_LAYER MXSSR3A.55
! NUMBER OF LAYERS MXSSR3A.56
& , N_CLOUD_TOP MXSSR3A.57
! TOP CLOUDY LAYER MXSSR3A.58
! MXSSR3A.59
! SPECIAL ARRAYS FOR EQUIVALENT EXTINCTION: MXSSR3A.60
LOGICAL !, INTENT(IN) MXSSR3A.61
& L_SCALE_SOLAR MXSSR3A.62
! SCALING APPLIED TO SOLAR FLUX MXSSR3A.63
REAL !, INTENT(IN) MXSSR3A.64
& ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER) MXSSR3A.65
! ADJUSTMENT TO SOLAR FLUXES WITH EQUIVALENT EXTINCTION MXSSR3A.66
! MXSSR3A.67
REAL !, INTENT(IN) MXSSR3A.68
& FLUX_INC_DIRECT(NPD_PROFILE) MXSSR3A.69
! INCIDENT DIRECT SOLAR FLUX MXSSR3A.70
! MXSSR3A.71
! CLEAR-SKY OPTICAL PROPERTIES: MXSSR3A.72
REAL !, INTENT(IN) MXSSR3A.73
& TRANS_0_FREE(NPD_PROFILE, NPD_LAYER) MXSSR3A.74
! FREE DIRECT TRANSMISSION MXSSR3A.75
& , SOURCE_COEFF_FREE(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF) MXSSR3A.76
! CLEAR-SKY SOURCE COEFFICIENTS MXSSR3A.77
! MXSSR3A.78
! CLOUDY OPTICAL PROPERTIES: MXSSR3A.79
REAL !, INTENT(IN) MXSSR3A.80
& TRANS_0_CLOUD(NPD_PROFILE, NPD_LAYER) MXSSR3A.81
! CLOUDY TRANSMISSION MXSSR3A.82
& , SOURCE_COEFF_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF) MXSSR3A.83
! CLOUDY REFLECTANCE MXSSR3A.84
! MXSSR3A.85
! ENERGY TRANSFER COEFFICIENTS: MXSSR3A.86
REAL !, INTENT(IN) MXSSR3A.87
& G_FF(NPD_PROFILE, 0: NPD_LAYER) MXSSR3A.88
! ENERGY TRANSFER COEFFICIENT MXSSR3A.89
& , G_FC(NPD_PROFILE, 0: NPD_LAYER) MXSSR3A.90
! ENERGY TRANSFER COEFFICIENT MXSSR3A.91
& , G_CF(NPD_PROFILE, 0: NPD_LAYER) MXSSR3A.92
! ENERGY TRANSFER COEFFICIENT MXSSR3A.93
& , G_CC(NPD_PROFILE, 0: NPD_LAYER) MXSSR3A.94
! ENERGY TRANSFER COEFFICIENT MXSSR3A.95
! MXSSR3A.96
! CALCULATED DIRECT FLUX AND SOURCE TERMS: MXSSR3A.97
REAL !, INTENT(OUT) MXSSR3A.98
& FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER) MXSSR3A.99
! DIRECT FLUX MXSSR3A.100
& , FLUX_DIRECT_GROUND_CLOUD(NPD_PROFILE) ADB1F401.679
! DIRECT CLOUDY FLUX AT GROUND ADB1F401.680
& , S_UP_FREE(NPD_PROFILE, NPD_LAYER) MXSSR3A.101
! FREE UPWARD SOURCE FUNCTION MXSSR3A.102
& , S_DOWN_FREE(NPD_PROFILE, NPD_LAYER) MXSSR3A.103
! FREE DOWNWARD SOURCE FUNCTION MXSSR3A.104
& , S_UP_CLOUD(NPD_PROFILE, NPD_LAYER) MXSSR3A.105
! CLOUDY UPWARD SOURCE FUNCTION MXSSR3A.106
& , S_DOWN_CLOUD(NPD_PROFILE, NPD_LAYER) MXSSR3A.107
! CLOUDY DOWNWARD SOURCE FUNCTION MXSSR3A.108
! MXSSR3A.109
! MXSSR3A.110
! LOCAL VARIABLES. MXSSR3A.111
INTEGER MXSSR3A.112
& I MXSSR3A.113
! LOOP VARIABLE MXSSR3A.114
& , L MXSSR3A.115
! LOOP VARIABLE MXSSR3A.116
! MXSSR3A.117
REAL MXSSR3A.118
& SOLAR_TOP_FREE(NPD_PROFILE) MXSSR3A.119
! FREE SOLAR FLUX AT TOP OF LAYER MXSSR3A.120
& , SOLAR_TOP_CLOUD(NPD_PROFILE) MXSSR3A.121
! CLOUDY SOLAR FLUX AT TOP OF LAYER MXSSR3A.122
& , SOLAR_BASE_FREE(NPD_PROFILE) MXSSR3A.123
! FREE SOLAR FLUX AT BASE OF LAYER MXSSR3A.124
& , SOLAR_BASE_CLOUD(NPD_PROFILE) MXSSR3A.125
! CLOUDY SOLAR FLUX AT BASE OF LAYER MXSSR3A.126
! MXSSR3A.127
! MXSSR3A.128
! MXSSR3A.129
! THE CLEAR AND CLOUDY DIRECT FLUXES ARE CALCULATED SEPARATELY MXSSR3A.130
! AND ADDED TOGETHER TO FORM THE TOTAL DIRECT FLUX. MXSSR3A.131
! MXSSR3A.132
! SET INCIDENT FLUXES. MXSSR3A.133
DO L=1, N_PROFILE MXSSR3A.134
FLUX_DIRECT(L, 0)=FLUX_INC_DIRECT(L) MXSSR3A.135
ENDDO MXSSR3A.136
! MXSSR3A.137
! WITH EQUIVALENT EXTINCTION THE DIRECT SOLAR FLUX MUST BE MXSSR3A.138
! CORRECTED. MXSSR3A.139
! MXSSR3A.140
IF (L_SCALE_SOLAR) THEN MXSSR3A.141
! MXSSR3A.142
DO I=1, N_CLOUD_TOP-1 MXSSR3A.143
DO L=1, N_PROFILE MXSSR3A.144
FLUX_DIRECT(L, I) MXSSR3A.145
& =FLUX_DIRECT(L, I-1)*TRANS_0_FREE(L, I) MXSSR3A.146
& *ADJUST_SOLAR_KE(L, I) MXSSR3A.147
S_UP_FREE(L, I)=SOURCE_COEFF_FREE(L, I, IP_SCF_SOLAR_UP) ADB1F401.681
& *FLUX_DIRECT(L, I-1) ADB1F401.682
S_DOWN_FREE(L, I) ADB1F401.683
& =(SOURCE_COEFF_FREE(L, I, IP_SCF_SOLAR_DOWN) ADB1F401.684
& -TRANS_0_FREE(L, I))*FLUX_DIRECT(L, I-1) ADB1F401.685
& +FLUX_DIRECT(L, I) ADB1F401.686
ENDDO MXSSR3A.148
ENDDO MXSSR3A.149
! MXSSR3A.150
ELSE MXSSR3A.151
! MXSSR3A.152
DO I=1, N_CLOUD_TOP-1 MXSSR3A.153
DO L=1, N_PROFILE MXSSR3A.154
FLUX_DIRECT(L, I) MXSSR3A.155
& =FLUX_DIRECT(L, I-1)*TRANS_0_FREE(L, I) MXSSR3A.156
S_UP_FREE(L, I)=SOURCE_COEFF_FREE(L, I, IP_SCF_SOLAR_UP) ADB1F401.687
& *FLUX_DIRECT(L, I-1) ADB1F401.688
S_DOWN_FREE(L, I) ADB1F401.689
& =SOURCE_COEFF_FREE(L, I, IP_SCF_SOLAR_DOWN) ADB1F401.690
& *FLUX_DIRECT(L, I-1) ADB1F401.691
ENDDO MXSSR3A.157
ENDDO MXSSR3A.158
! MXSSR3A.159
ENDIF MXSSR3A.160
! MXSSR3A.172
! MXSSR3A.173
! MXSSR3A.174
! CLEAR AND CLOUDY REGION. MXSSR3A.175
! INITIALIZE PARTIAL FLUXES: MXSSR3A.176
DO L=1, N_PROFILE MXSSR3A.177
SOLAR_BASE_FREE(L)=FLUX_DIRECT(L, N_CLOUD_TOP-1) MXSSR3A.178
SOLAR_BASE_CLOUD(L)=0.0E+00 MXSSR3A.179
ENDDO MXSSR3A.180
! MXSSR3A.181
! MXSSR3A.182
DO I=N_CLOUD_TOP, N_LAYER MXSSR3A.183
! MXSSR3A.184
! TRANSFER FLUXES ACROSS THE INTERFACE. THE USE OF ONLY ONE MXSSR3A.185
! CLOUDY FLUX IMPLICITLY FORCES RANDOM OVERLAP OF DIFFERENT MXSSR3A.186
! SUBCLOUDS WITHIN THE CLOUDY PARTS OF THE LAYER. MXSSR3A.187
! MXSSR3A.188
DO L=1, N_PROFILE MXSSR3A.189
SOLAR_TOP_CLOUD(L)=G_CC(L, I-1)*SOLAR_BASE_CLOUD(L) MXSSR3A.190
& +G_FC(L, I-1)*SOLAR_BASE_FREE(L) MXSSR3A.191
SOLAR_TOP_FREE(L)=G_FF(L, I-1)*SOLAR_BASE_FREE(L) MXSSR3A.192
& +G_CF(L, I-1)*SOLAR_BASE_CLOUD(L) MXSSR3A.193
ENDDO MXSSR3A.194
! MXSSR3A.195
! MXSSR3A.196
! PROPAGATE THE CLEAR AND CLOUDY FLUXES THROUGH THE LAYER: MXSSR3A.197
! MXSSR3A.198
IF (L_SCALE_SOLAR) THEN MXSSR3A.199
! MXSSR3A.200
DO L=1, N_PROFILE MXSSR3A.201
SOLAR_BASE_FREE(L)=SOLAR_TOP_FREE(L) MXSSR3A.202
& *TRANS_0_FREE(L, I)*ADJUST_SOLAR_KE(L, I) MXSSR3A.203
SOLAR_BASE_CLOUD(L)=SOLAR_TOP_CLOUD(L) MXSSR3A.204
& *TRANS_0_CLOUD(L, I)*ADJUST_SOLAR_KE(L, I) MXSSR3A.205
S_UP_FREE(L, I)=SOURCE_COEFF_FREE(L, I, IP_SCF_SOLAR_UP) ADB1F401.692
& *SOLAR_TOP_FREE(L) ADB1F401.693
S_DOWN_FREE(L, I) ADB1F401.694
& =(SOURCE_COEFF_FREE(L, I, IP_SCF_SOLAR_DOWN) ADB1F401.695
& -TRANS_0_FREE(L, I))*SOLAR_TOP_FREE(L) ADB1F401.696
& +SOLAR_BASE_FREE(L) ADB1F401.697
S_UP_CLOUD(L, I) ADB1F401.698
& =SOURCE_COEFF_CLOUD(L, I, IP_SCF_SOLAR_UP) ADB1F401.699
& *SOLAR_TOP_CLOUD(L) ADB1F401.700
S_DOWN_CLOUD(L, I) ADB1F401.701
& =(SOURCE_COEFF_CLOUD(L, I, IP_SCF_SOLAR_DOWN) ADB1F401.702
& -TRANS_0_CLOUD(L, I))*SOLAR_TOP_CLOUD(L) ADB1F401.703
& +SOLAR_BASE_CLOUD(L) ADB1F401.704
ENDDO MXSSR3A.206
! MXSSR3A.207
ELSE MXSSR3A.208
! MXSSR3A.209
DO L=1, N_PROFILE MXSSR3A.210
SOLAR_BASE_FREE(L)=SOLAR_TOP_FREE(L) MXSSR3A.211
& *TRANS_0_FREE(L, I) MXSSR3A.212
SOLAR_BASE_CLOUD(L)=SOLAR_TOP_CLOUD(L) MXSSR3A.213
& *TRANS_0_CLOUD(L, I) MXSSR3A.214
S_UP_FREE(L, I)=SOURCE_COEFF_FREE(L, I, IP_SCF_SOLAR_UP) ADB1F401.705
& *SOLAR_TOP_FREE(L) ADB1F401.706
S_DOWN_FREE(L, I) ADB1F401.707
& =SOURCE_COEFF_FREE(L, I, IP_SCF_SOLAR_DOWN) ADB1F401.708
& *SOLAR_TOP_FREE(L) ADB1F401.709
S_UP_CLOUD(L, I) ADB1F401.710
& =SOURCE_COEFF_CLOUD(L, I, IP_SCF_SOLAR_UP) ADB1F401.711
& *SOLAR_TOP_CLOUD(L) ADB1F401.712
S_DOWN_CLOUD(L, I) ADB1F401.713
& =SOURCE_COEFF_CLOUD(L, I, IP_SCF_SOLAR_DOWN) ADB1F401.714
& *SOLAR_TOP_CLOUD(L) ADB1F401.715
ENDDO MXSSR3A.215
! MXSSR3A.216
ENDIF MXSSR3A.217
! MXSSR3A.233
! MXSSR3A.234
! CALCULATE THE TOTAL DIRECT FLUX. MXSSR3A.235
! MXSSR3A.236
DO L=1, N_PROFILE MXSSR3A.237
FLUX_DIRECT(L, I)=SOLAR_BASE_FREE(L)+SOLAR_BASE_CLOUD(L) MXSSR3A.238
ENDDO MXSSR3A.239
! MXSSR3A.240
ENDDO ADB1F401.716
! ADB1F401.717
! PASS THE LAST VALUE AT THE BASE OF THE CLOUD OUT. ADB1F401.718
DO L=1, N_PROFILE ADB1F401.719
FLUX_DIRECT_GROUND_CLOUD(L)=SOLAR_BASE_CLOUD(L) ADB1F401.720
ENDDO MXSSR3A.241
! MXSSR3A.242
! MXSSR3A.243
! MXSSR3A.244
RETURN MXSSR3A.245
END MXSSR3A.246
*ENDIF DEF,A01_3A,OR,DEF,A02_3A MXSSR3A.247
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.56