*IF DEF,A70_1B SLVTRP3B.2 *IF DEF,A01_3A,OR,DEF,A02_3A SLVTRP3B.3 C *****************************COPYRIGHT****************************** SLVTRP3B.4 C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. SLVTRP3B.5 C SLVTRP3B.6 C Use, duplication or disclosure of this code is subject to the SLVTRP3B.7 C restrictions as set forth in the contract. SLVTRP3B.8 C SLVTRP3B.9 C Meteorological Office SLVTRP3B.10 C London Road SLVTRP3B.11 C BRACKNELL SLVTRP3B.12 C Berkshire UK SLVTRP3B.13 C RG12 2SZ SLVTRP3B.14 C SLVTRP3B.15 C If no contract has been raised with this copy of the code, the use, SLVTRP3B.16 C duplication or disclosure of it is strictly prohibited. Permission SLVTRP3B.17 C to do so must first be obtained in writing from the Head of Numerical SLVTRP3B.18 C Modelling at the above address. SLVTRP3B.19 C ******************************COPYRIGHT****************************** SLVTRP3B.20 C SLVTRP3B.21 !+ Subroutine to solve for mixed fluxes scattering without a matrix. SLVTRP3B.22 ! SLVTRP3B.23 ! Method: SLVTRP3B.24 ! Gaussian elimination in an upward direction is employed to SLVTRP3B.25 ! determine effective albedos for lower levels of the atmosphere. SLVTRP3B.26 ! This allows a downward pass of back-substitution to be carried SLVTRP3B.27 ! out to determine the upward and downward fluxes. SLVTRP3B.28 ! SLVTRP3B.29 ! Current Owner of Code: J. M. Edwards SLVTRP3B.30 ! SLVTRP3B.31 ! History: SLVTRP3B.32 ! Version Date Comment SLVTRP3B.33 ! 4.5 11-06-98 Optimised version SLVTRP3B.34 ! (P. Burton) SLVTRP3B.35 ! SLVTRP3B.36 ! Description of Code: SLVTRP3B.37 ! FORTRAN 77 with extensions listed in documentation. SLVTRP3B.38 ! SLVTRP3B.39 !- --------------------------------------------------------------------- SLVTRP3B.40SUBROUTINE SOLVER_TRIPLE(N_PROFILE, N_LAYER, N_CLOUD_TOP 1SLVTRP3B.41 & , T, R, S_DOWN, S_UP SLVTRP3B.42 & , T_STRAT, R_STRAT, S_DOWN_STRAT, S_UP_STRAT SLVTRP3B.43 & , T_CONV, R_CONV, S_DOWN_CONV, S_UP_CONV SLVTRP3B.44 & , V11, V12, V13, V21, V22, V23, V31, V32, V33 SLVTRP3B.45 & , U11, U12, U13, U21, U22, U23, U31, U32, U33 SLVTRP3B.46 & , L_NET SLVTRP3B.47 & , FLUX_INC_DOWN SLVTRP3B.48 & , SOURCE_GROUND_FREE, SOURCE_GROUND_STRAT SLVTRP3B.49 & , SOURCE_GROUND_CONV, ALBEDO_SURFACE_DIFF SLVTRP3B.50 & , FLUX_TOTAL SLVTRP3B.51 & , NPD_PROFILE, NPD_LAYER SLVTRP3B.52 & ) SLVTRP3B.53 ! SLVTRP3B.54 ! SLVTRP3B.55 IMPLICIT NONE SLVTRP3B.56 ! SLVTRP3B.57 ! SLVTRP3B.58 ! SIZES OF DUMMY ARRAYS. SLVTRP3B.59 INTEGER !, INTENT(IN) SLVTRP3B.60 & NPD_PROFILE SLVTRP3B.61 ! MAXIMUM NUMBER OF PROFILES SLVTRP3B.62 & , NPD_LAYER SLVTRP3B.63 ! MAXIMUM NUMBER OF LAYERS SLVTRP3B.64 ! SLVTRP3B.65 ! SLVTRP3B.66 ! DUMMY ARGUMENTS. SLVTRP3B.67 INTEGER !, INTENT(IN) SLVTRP3B.68 & N_PROFILE SLVTRP3B.69 ! NUMBER OF PROFILES SLVTRP3B.70 & , N_LAYER SLVTRP3B.71 ! NUMBER OF LAYERS SLVTRP3B.72 & , N_CLOUD_TOP SLVTRP3B.73 ! TOPMOST CLOUDY LAYER SLVTRP3B.74 LOGICAL !, INTENT(IN) SLVTRP3B.75 & L_NET SLVTRP3B.76 ! FLAG FOR CALCULATION OF NET FLUXES SLVTRP3B.77 REAL !, INTENT(IN) SLVTRP3B.78 & T(NPD_PROFILE, NPD_LAYER) SLVTRP3B.79 ! CLEAR-SKY TRANSMISSION SLVTRP3B.80 & , R(NPD_PROFILE, NPD_LAYER) SLVTRP3B.81 ! CLEAR-SKY REFLECTION SLVTRP3B.82 & , S_DOWN(NPD_PROFILE, NPD_LAYER) SLVTRP3B.83 ! CLEAR-SKY DOWNWARD SOURCE FUNCTION SLVTRP3B.84 & , S_UP(NPD_PROFILE, NPD_LAYER) SLVTRP3B.85 ! CLEAR-SKY UPWARD SOURCE FUNCTION SLVTRP3B.86 & , T_STRAT(NPD_PROFILE, NPD_LAYER) SLVTRP3B.87 ! STRATFIFORM TRANSMISSION SLVTRP3B.88 & , R_STRAT(NPD_PROFILE, NPD_LAYER) SLVTRP3B.89 ! STRATFIFORM REFLECTION SLVTRP3B.90 & , S_DOWN_STRAT(NPD_PROFILE, NPD_LAYER) SLVTRP3B.91 ! DOWNWARD STRATFIFORM SOURCE FUNCTION SLVTRP3B.92 & , S_UP_STRAT(NPD_PROFILE, NPD_LAYER) SLVTRP3B.93 ! UPWARD STRATFIFORM SOURCE FUNCTION SLVTRP3B.94 & , T_CONV(NPD_PROFILE, NPD_LAYER) SLVTRP3B.95 ! CONVECTIVE TRANSMISSION SLVTRP3B.96 & , R_CONV(NPD_PROFILE, NPD_LAYER) SLVTRP3B.97 ! CONVECTIVE REFLECTION SLVTRP3B.98 & , S_DOWN_CONV(NPD_PROFILE, NPD_LAYER) SLVTRP3B.99 ! DOWNWARD CONVECTIVE SOURCE FUNCTION SLVTRP3B.100 & , S_UP_CONV(NPD_PROFILE, NPD_LAYER) SLVTRP3B.101 ! UPWARD CONVECTIVE SOURCE FUNCTION SLVTRP3B.102 REAL !, INTENT(IN) SLVTRP3B.103 & V11(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.104 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.105 & , V12(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.106 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.107 & , V13(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.108 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.109 & , V21(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.110 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.111 & , V22(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.112 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.113 & , V23(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.114 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.115 & , V31(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.116 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.117 & , V32(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.118 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.119 & , V33(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.120 ! ENERGY TRANSFER COEFFICIENT FOR DOWNWARD RADIATION SLVTRP3B.121 REAL SLVTRP3B.122 & U11(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.123 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.124 & , U12(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.125 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.126 & , U13(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.127 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.128 & , U21(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.129 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.130 & , U22(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.131 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.132 & , U23(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.133 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.134 & , U31(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.135 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.136 & , U32(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.137 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.138 & , U33(NPD_PROFILE, 0: NPD_LAYER) SLVTRP3B.139 ! ENERGY TRANSFER COEFFICIENT FOR UPWARD RADIATION SLVTRP3B.140 REAL !, INTENT(IN) SLVTRP3B.141 & FLUX_INC_DOWN(NPD_PROFILE) SLVTRP3B.142 ! INCIDENT FLUX SLVTRP3B.143 & , SOURCE_GROUND_FREE(NPD_PROFILE) SLVTRP3B.144 ! SOURCE FROM GROUND (CLEAR SKY) SLVTRP3B.145 & , SOURCE_GROUND_STRAT(NPD_PROFILE) SLVTRP3B.146 ! SOURCE FROM GROUND (CLOUDY REGION) SLVTRP3B.147 & , SOURCE_GROUND_CONV(NPD_PROFILE) SLVTRP3B.148 ! SOURCE FROM GROUND (CLOUDY REGION) SLVTRP3B.149 & , ALBEDO_SURFACE_DIFF(NPD_PROFILE) SLVTRP3B.150 ! DIFFUSE ALBEDO SLVTRP3B.151 REAL !, INTENT(OUT) SLVTRP3B.152 & FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2) SLVTRP3B.153 ! TOTAL FLUX SLVTRP3B.154 ! SLVTRP3B.155 ! LOCAL VARIABLES. SLVTRP3B.156 INTEGER SLVTRP3B.157 & I SLVTRP3B.158 ! LOOP VARIABLE SLVTRP3B.159 & , L SLVTRP3B.160 ! LOOP VARIABLE SLVTRP3B.161 ! SLVTRP3B.162 ! EFFECTIVE COUPLING ALBEDOS AND SOURCE FUNCTIONS: SLVTRP3B.163 REAL SLVTRP3B.164 & ALPHA(3,3,NPD_LAYER+1),G(3,NPD_LAYER+1) SLVTRP3B.165 SLVTRP3B.166 ! TERMS FOR DOWNWARD PROPAGATION: SLVTRP3B.167 REAL SLVTRP3B.168 & GAMMA(3,3,NPD_LAYER), H(3,NPD_LAYER) SLVTRP3B.169 & , BETA(3,3,NPD_LAYER) SLVTRP3B.170 SLVTRP3B.171 ! AUXILAIRY NUMERICAL VARIABLES REQUIRED ONLY IN THE CURRENT LAYER: SLVTRP3B.172 REAL SLVTRP3B.173 & THETA(3,3,0:NPD_LAYER) SLVTRP3B.174 & , LAMBDA(0:3,0:NPD_LAYER) SLVTRP3B.175 ! SLVTRP3B.176 ! TEMPORARY FLUXES SLVTRP3B.177 REAL SLVTRP3B.178 & FLUX_DOWN(3,0: NPD_LAYER) SLVTRP3B.179 & , FLUX_UP(3,0: NPD_LAYER) SLVTRP3B.180 & , FLUX_TEMP(6,0:NPD_LAYER) SLVTRP3B.181 SLVTRP3B.182 ! New temporary arrays for the optimised version SLVTRP3B.183 REAL SLVTRP3B.184 & UV(18,0:NPD_LAYER,NPD_PROFILE) SLVTRP3B.185 & , T_R(12,NPD_LAYER,NPD_PROFILE) SLVTRP3B.186 SLVTRP3B.187 SLVTRP3B.188 ! THIS ROUTINE IS SPECIFIC TO CASES OF THREE REGIONS AND IT IS SLVTRP3B.189 ! ASSUMED THAT 1 REPRESENTS CLEAR SKIES, 2 REPRESENTS STARTIFORM SLVTRP3B.190 ! CLOUDS AND 3 REPRESENTS CONVECTIVE CLOUD. SLVTRP3B.191 SLVTRP3B.192 ! Write U and V into a scalar array SLVTRP3B.193 SLVTRP3B.194 DO I = 0,N_LAYER SLVTRP3B.195 !*DIR$ CACHE_BYPASS UV,V11,V21,V31,V12 SLVTRP3B.196 DO L=1,N_PROFILE SLVTRP3B.197 UV(1,I,L) = V11(L,I) SLVTRP3B.198 UV(2,I,L) = V21(L,I) SLVTRP3B.199 UV(3,I,L) = V31(L,I) SLVTRP3B.200 UV(4,I,L) = V12(L,I) SLVTRP3B.201 END DO SLVTRP3B.202 END DO SLVTRP3B.203 DO I=0,N_LAYER SLVTRP3B.204 !*DIR$ CACHE_BYPASS UV,V22,V32,V13,V23 SLVTRP3B.205 DO L=1,N_PROFILE SLVTRP3B.206 UV(5,I,L) = V22(L,I) SLVTRP3B.207 UV(6,I,L) = V32(L,I) SLVTRP3B.208 UV(7,I,L) = V13(L,I) SLVTRP3B.209 UV(8,I,L) = V23(L,I) SLVTRP3B.210 END DO SLVTRP3B.211 END DO SLVTRP3B.212 DO I=0,N_LAYER SLVTRP3B.213 !*DIR$ CACHE_BYPASS UV,U11,U21,U31,V33 SLVTRP3B.214 DO L=1,N_PROFILE SLVTRP3B.215 UV(9,I,L) = V33(L,I) SLVTRP3B.216 UV(10,I,L) = U11(L,I) SLVTRP3B.217 UV(11,I,L) = U21(L,I) SLVTRP3B.218 UV(12,I,L) = U31(L,I) SLVTRP3B.219 END DO SLVTRP3B.220 END DO SLVTRP3B.221 DO I=0,N_LAYER SLVTRP3B.222 !*DIR$ CACHE_BYPASS UV,U12,U22,U32,U13 SLVTRP3B.223 DO L=1,N_PROFILE SLVTRP3B.224 UV(13,I,L) = U12(L,I) SLVTRP3B.225 UV(14,I,L) = U22(L,I) SLVTRP3B.226 UV(15,I,L) = U32(L,I) SLVTRP3B.227 UV(16,I,L) = U13(L,I) SLVTRP3B.228 END DO SLVTRP3B.229 END DO SLVTRP3B.230 DO I=0,N_LAYER SLVTRP3B.231 !*DIR$ CACHE_BYPASS UV,U23,U33 SLVTRP3B.232 DO L=1,N_PROFILE SLVTRP3B.233 UV(17,I,L) = U23(L,I) SLVTRP3B.234 UV(18,I,L) = U33(L,I) SLVTRP3B.235 END DO SLVTRP3B.236 END DO SLVTRP3B.237 DO I=1,N_LAYER SLVTRP3B.238 !*DIR$ CACHE_BYPASS T_R,T,T_STRAT,T_CONV,R SLVTRP3B.239 DO L=1,N_PROFILE SLVTRP3B.240 T_R(1,I,L) = T(L,I) SLVTRP3B.241 T_R(2,I,L) = T_STRAT(L,I) SLVTRP3B.242 T_R(3,I,L) = T_CONV(L,I) SLVTRP3B.243 T_R(4,I,L) = R(L,I) SLVTRP3B.244 END DO SLVTRP3B.245 END DO SLVTRP3B.246 DO I=1,N_LAYER SLVTRP3B.247 !*DIR$ CACHE_BYPASS T_R,R_STRAT,R_CONV,S_DOWN,S_UP SLVTRP3B.248 DO L=1,N_PROFILE SLVTRP3B.249 T_R(5,I,L) = R_STRAT(L,I) SLVTRP3B.250 T_R(6,I,L) = R_CONV(L,I) SLVTRP3B.251 T_R(7,I,L) = S_DOWN(L,I) SLVTRP3B.252 T_R(8,I,L) = S_UP(L,I) SLVTRP3B.253 END DO SLVTRP3B.254 END DO SLVTRP3B.255 DO I=1,N_LAYER SLVTRP3B.256 !*DIR$ CACHE_BYPASS T_R,S_DOWN_STRAT,S_UP_STRAT,S_UP_CONV,S_DOWN_CONV SLVTRP3B.257 DO L=1,N_PROFILE SLVTRP3B.258 T_R(9,I,L) = S_DOWN_STRAT(L,I) SLVTRP3B.259 T_R(10,I,L) = S_UP_STRAT(L,I) SLVTRP3B.260 T_R(11,I,L) = S_DOWN_CONV(L,I) SLVTRP3B.261 T_R(12,I,L) = S_UP_CONV(L,I) SLVTRP3B.262 END DO SLVTRP3B.263 END DO SLVTRP3B.264 SLVTRP3B.265 ! SLVTRP3B.266 ! INITIALIZE AT THE BOTTOM OF THE COLUMN FOR UPWARD ELIMINATION. SLVTRP3B.267 DO L=1, N_PROFILE SLVTRP3B.268 ALPHA(1,1,N_LAYER+1)=ALBEDO_SURFACE_DIFF(L) SLVTRP3B.269 ALPHA(1,2,N_LAYER+1)=0.0E+00 SLVTRP3B.270 ALPHA(1,3,N_LAYER+1)=0.0E+00 SLVTRP3B.271 ALPHA(2,1,N_LAYER+1)=0.0E+00 SLVTRP3B.272 ALPHA(2,2,N_LAYER+1)=ALBEDO_SURFACE_DIFF(L) SLVTRP3B.273 ALPHA(2,3,N_LAYER+1)=0.0E+00 SLVTRP3B.274 ALPHA(3,1,N_LAYER+1)=0.0E+00 SLVTRP3B.275 ALPHA(3,2,N_LAYER+1)=0.0E+00 SLVTRP3B.276 ALPHA(3,3,N_LAYER+1)=ALBEDO_SURFACE_DIFF(L) SLVTRP3B.277 G(1,N_LAYER+1)=SOURCE_GROUND_FREE(L) SLVTRP3B.278 G(2,N_LAYER+1)=SOURCE_GROUND_STRAT(L) SLVTRP3B.279 G(3,N_LAYER+1)=SOURCE_GROUND_CONV(L) SLVTRP3B.280 ! SLVTRP3B.281 ! UPWARD ELIMINATION THROUGH THE CLOUDY LAYERS. SLVTRP3B.282 SLVTRP3B.283 SLVTRP3B.284 DO I=N_LAYER, N_CLOUD_TOP, -1 SLVTRP3B.285 THETA(1,1,I)=ALPHA(1,1,I+1)*UV(1,I,L) SLVTRP3B.286 & +ALPHA(1,2,I+1)*UV(2,I,L) SLVTRP3B.287 & +ALPHA(1,3,I+1)*UV(3,I,L) SLVTRP3B.288 THETA(1,2,I)=ALPHA(1,1,I+1)*UV(4,I,L) SLVTRP3B.289 & +ALPHA(1,2,I+1)*UV(5,I,L) SLVTRP3B.290 & +ALPHA(1,3,I+1)*UV(6,I,L) SLVTRP3B.291 THETA(1,3,I)=ALPHA(1,1,I+1)*UV(7,I,L) SLVTRP3B.292 & +ALPHA(1,2,I+1)*UV(8,I,L) SLVTRP3B.293 & +ALPHA(1,3,I+1)*UV(9,I,L) SLVTRP3B.294 THETA(2,1,I)=ALPHA(2,1,I+1)*UV(1,I,L) SLVTRP3B.295 & +ALPHA(2,2,I+1)*UV(2,I,L) SLVTRP3B.296 & +ALPHA(2,3,I+1)*UV(3,I,L) SLVTRP3B.297 THETA(2,2,I)=ALPHA(2,1,I+1)*UV(4,I,L) SLVTRP3B.298 & +ALPHA(2,2,I+1)*UV(5,I,L) SLVTRP3B.299 & +ALPHA(2,3,I+1)*UV(6,I,L) SLVTRP3B.300 THETA(2,3,I)=ALPHA(2,1,I+1)*UV(7,I,L) SLVTRP3B.301 & +ALPHA(2,2,I+1)*UV(8,I,L) SLVTRP3B.302 & +ALPHA(2,3,I+1)*UV(9,I,L) SLVTRP3B.303 THETA(3,1,I)=ALPHA(3,1,I+1)*UV(1,I,L) SLVTRP3B.304 & +ALPHA(3,2,I+1)*UV(2,I,L) SLVTRP3B.305 & +ALPHA(3,3,I+1)*UV(3,I,L) SLVTRP3B.306 THETA(3,2,I)=ALPHA(3,1,I+1)*UV(4,I,L) SLVTRP3B.307 & +ALPHA(3,2,I+1)*UV(5,I,L) SLVTRP3B.308 & +ALPHA(3,3,I+1)*UV(6,I,L) SLVTRP3B.309 THETA(3,3,I)=ALPHA(3,1,I+1)*UV(7,I,L) SLVTRP3B.310 & +ALPHA(3,2,I+1)*UV(8,I,L) SLVTRP3B.311 & +ALPHA(3,3,I+1)*UV(9,I,L) SLVTRP3B.312 SLVTRP3B.313 BETA(3,1,I)=-THETA(3,1,I)*T_R(4,I,L) SLVTRP3B.314 BETA(3,2,I)=-THETA(3,2,I)*T_R(5,I,L) SLVTRP3B.315 BETA(3,3,I)=1.0E+00/(1.0E+00-THETA(3,3,I)*T_R(6,I,L)) SLVTRP3B.316 GAMMA(3,1,I)=THETA(3,1,I)*T_R(1,I,L) SLVTRP3B.317 GAMMA(3,2,I)=THETA(3,2,I)*T_R(2,I,L) SLVTRP3B.318 GAMMA(3,3,I)=THETA(3,3,I)*T_R(3,I,L) SLVTRP3B.319 H(3,I)=G(3,I+1)+THETA(3,1,I)*T_R(7,I,L) SLVTRP3B.320 & +THETA(3,2,I)*T_R(9,I,L) SLVTRP3B.321 & +THETA(3,3,I)*T_R(11,I,L) SLVTRP3B.322 ! SLVTRP3B.323 LAMBDA(3,I)=THETA(2,3,I)*T_R(6,I,L)*BETA(3,3,I) SLVTRP3B.324 BETA(2,2,I)=1.0E+00 SLVTRP3B.325 & /(1.0E+00-THETA(2,2,I)*T_R(5,I,L) SLVTRP3B.326 & +LAMBDA(3,I)*BETA(3,2,I)) SLVTRP3B.327 BETA(2,1,I)=-THETA(2,1,I)*T_R(4,I,L)+LAMBDA(3,I)*BETA(3,1,I) SLVTRP3B.328 GAMMA(2,1,I)=THETA(2,1,I)*T_R(1,I,L) SLVTRP3B.329 & +LAMBDA(3,I)*GAMMA(3,1,I) SLVTRP3B.330 GAMMA(2,2,I)=THETA(2,2,I)*T_R(2,I,L)+ SLVTRP3B.331 & LAMBDA(3,I)*GAMMA(3,2,I) SLVTRP3B.332 GAMMA(2,3,I)=THETA(2,3,I)*T_R(3,I,L)+LAMBDA(3,I)* SLVTRP3B.333 & GAMMA(3,3,I) SLVTRP3B.334 H(2,I)=G(2,I+1)+THETA(2,1,I)*T_R(7,I,L) SLVTRP3B.335 & +THETA(2,2,I)*T_R(9,I,L) SLVTRP3B.336 & +THETA(2,3,I)*T_R(11,I,L) SLVTRP3B.337 & +LAMBDA(3,I)*H(3,I) SLVTRP3B.338 ! SLVTRP3B.339 LAMBDA(3,I)=THETA(1,3,I)*T_R(6,I,L)*BETA(3,3,I) SLVTRP3B.340 LAMBDA(2,I)=(THETA(1,2,I)*T_R(5,I,L) SLVTRP3B.341 & -LAMBDA(3,I)*BETA(3,2,I))*BETA(2,2,I) SLVTRP3B.342 BETA(1,1,I)=1.0E+00 SLVTRP3B.343 & /(1.0E+00-THETA(1,1,I)*T_R(4,I,L)+LAMBDA(3,I)*BETA(3,1,I) SLVTRP3B.344 & +LAMBDA(2,I)*BETA(2,1,I)) SLVTRP3B.345 GAMMA(1,1,I)=THETA(1,1,I)*T_R(1,I,L) SLVTRP3B.346 & +LAMBDA(3,I)*GAMMA(3,1,I) SLVTRP3B.347 & +LAMBDA(2,I)*GAMMA(2,1,I) SLVTRP3B.348 GAMMA(1,2,I)=THETA(1,2,I)*T_R(2,I,L) SLVTRP3B.349 & +LAMBDA(3,I)*GAMMA(3,2,I) SLVTRP3B.350 & +LAMBDA(2,I)*GAMMA(2,2,I) SLVTRP3B.351 GAMMA(1,3,I)=THETA(1,3,I)*T_R(3,I,L) SLVTRP3B.352 & +LAMBDA(3,I)*GAMMA(3,3,I) SLVTRP3B.353 & +LAMBDA(2,I)*GAMMA(2,3,I) SLVTRP3B.354 H(1,I)=G(1,I+1)+THETA(1,1,I)*T_R(7,I,L) SLVTRP3B.355 & +THETA(1,2,I)*T_R(9,I,L) SLVTRP3B.356 & +THETA(1,3,I)*T_R(11,I,L) SLVTRP3B.357 & +LAMBDA(3,I)*H(3,I)+LAMBDA(2,I)*H(2,I) SLVTRP3B.358 SLVTRP3B.359 ! SLVTRP3B.360 LAMBDA(3,I)=UV(18,I-1,L)*T_R(3,I,L)*BETA(3,3,I) SLVTRP3B.361 LAMBDA(2,I)=(UV(15,I-1,L)*T_R(2,I,L)+LAMBDA(3,I) SLVTRP3B.362 & *BETA(3,2,I))*BETA(2,2,I) SLVTRP3B.363 LAMBDA(1,I)=(UV(12,I-1,L)*T_R(1,I,L) SLVTRP3B.364 & +LAMBDA(3,I)*BETA(3,1,I) SLVTRP3B.365 & +LAMBDA(2,I)*BETA(2,1,I))*BETA(1,1,I) SLVTRP3B.366 ALPHA(3,1,I)=UV(12,I-1,L)*T_R(4,I,L) SLVTRP3B.367 & +LAMBDA(3,I)*GAMMA(3,1,I) SLVTRP3B.368 & +LAMBDA(2,I)*GAMMA(2,1,I)+LAMBDA(1,I)*GAMMA(1,1,I) SLVTRP3B.369 ALPHA(3,2,I)=UV(15,I-1,L)*T_R(5,I,L) SLVTRP3B.370 & +LAMBDA(3,I)*GAMMA(3,2,I)+LAMBDA(2,I)*GAMMA(2,2,I) SLVTRP3B.371 & +LAMBDA(1,I)*GAMMA(1,2,I) SLVTRP3B.372 ALPHA(3,3,I)=UV(18,I-1,L)*T_R(6,I,L) SLVTRP3B.373 & +LAMBDA(3,I)*GAMMA(3,3,I)+LAMBDA(2,I)*GAMMA(2,3,I) SLVTRP3B.374 & +LAMBDA(1,I)*GAMMA(1,3,I) SLVTRP3B.375 SLVTRP3B.376 ! SLVTRP3B.377 G(3,I)=UV(12,I-1,L)*T_R(8,I,L) SLVTRP3B.378 & + UV(15,I-1,L)*T_R(10,I,L) SLVTRP3B.379 & +UV(18,I-1,L)*T_R(12,I,L) SLVTRP3B.380 & +LAMBDA(3,I)*H(3,I)+LAMBDA(2,I)*H(2,I)+LAMBDA(1,I)*H(1,I) SLVTRP3B.381 ! SLVTRP3B.382 LAMBDA(3,I)=UV(17,I-1,l)*T_R(3,I,L)*BETA(3,3,I) SLVTRP3B.383 LAMBDA(2,I)=(UV(14,I-1,l)*T_R(2,I,L) SLVTRP3B.384 & +LAMBDA(3,I)*BETA(3,2,I))*BETA(2,2,I) SLVTRP3B.385 LAMBDA(1,I)=(UV(11,I-1,l)*T_R(1,I,L) SLVTRP3B.386 & +LAMBDA(3,I)*BETA(3,1,I) SLVTRP3B.387 & +LAMBDA(2,I)*BETA(2,1,I))*BETA(1,1,I) SLVTRP3B.388 ALPHA(2,1,I)=UV(11,I-1,L)*T_R(4,I,L) SLVTRP3B.389 & +LAMBDA(3,I)*GAMMA(3,1,I) SLVTRP3B.390 & +LAMBDA(2,I)*GAMMA(2,1,I)+LAMBDA(1,I)*GAMMA(1,1,I) SLVTRP3B.391 ALPHA(2,2,I)=UV(14,I-1,l)*T_R(5,I,L) SLVTRP3B.392 & +LAMBDA(3,I)*GAMMA(3,2,I)+LAMBDA(2,I)*GAMMA(2,2,I) SLVTRP3B.393 & +LAMBDA(1,I)*GAMMA(1,2,I) SLVTRP3B.394 ALPHA(2,3,I)=UV(17,I-1,L)*T_R(6,I,L) SLVTRP3B.395 & +LAMBDA(3,I)*GAMMA(3,3,I)+LAMBDA(2,I)*GAMMA(2,3,I) SLVTRP3B.396 & +LAMBDA(1,I)*GAMMA(1,3,I) SLVTRP3B.397 G(2,I)=UV(11,I-1,L)*T_R(8,I,L) SLVTRP3B.398 & +UV(14,I-1,L)*T_R(10,I,L) SLVTRP3B.399 & +UV(17,I-1,L)*T_R(12,I,L) SLVTRP3B.400 & +LAMBDA(3,I)*H(3,I)+LAMBDA(2,I)*H(2,I) SLVTRP3B.401 & +LAMBDA(1,I)*H(1,I) SLVTRP3B.402 ! SLVTRP3B.403 LAMBDA(3,I)=UV(16,I-1,L)*T_R(3,I,L)*BETA(3,3,I) SLVTRP3B.404 LAMBDA(2,I)=(UV(13,I-1,L)*T_R(2,I,L) SLVTRP3B.405 & +LAMBDA(3,I)*BETA(3,2,I)) SLVTRP3B.406 & *BETA(2,2,I) SLVTRP3B.407 LAMBDA(1,I)=(UV(10,I-1,L)*T_R(1,I,L) SLVTRP3B.408 & +LAMBDA(3,I)*BETA(3,1,I) SLVTRP3B.409 & +LAMBDA(2,I)*BETA(2,1,I))*BETA(1,1,I) SLVTRP3B.410 ALPHA(1,1,I)=UV(10,I-1,L)*T_R(4,I,L) SLVTRP3B.411 & +LAMBDA(3,I)*GAMMA(3,1,I) SLVTRP3B.412 & +LAMBDA(2,I)*GAMMA(2,1,I)+LAMBDA(1,I)*GAMMA(1,1,I) SLVTRP3B.413 ALPHA(1,2,I)=UV(13,I-1,L)*T_R(5,I,L) SLVTRP3B.414 & +LAMBDA(3,I)*GAMMA(3,2,I)+LAMBDA(2,I)*GAMMA(2,2,I) SLVTRP3B.415 & +LAMBDA(1,I)*GAMMA(1,2,I) SLVTRP3B.416 ALPHA(1,3,I)=UV(16,I-1,L)*T_R(6,I,L) SLVTRP3B.417 & +LAMBDA(3,I)*GAMMA(3,3,I)+LAMBDA(2,I)*GAMMA(2,3,I) SLVTRP3B.418 & +LAMBDA(1,I)*GAMMA(1,3,I) SLVTRP3B.419 G(1,I)=UV(10,I-1,L)*T_R(8,I,L) SLVTRP3B.420 & +UV(13,I-1,L)*T_R(10,I,L) SLVTRP3B.421 & +UV(16,I-1,L)*T_R(12,I,L) SLVTRP3B.422 & +LAMBDA(3,I)*H(3,I) SLVTRP3B.423 & +LAMBDA(2,I)*H(2,I)+LAMBDA(1,I)*H(1,I) SLVTRP3B.424 ! SLVTRP3B.425 ENDDO SLVTRP3B.426 ! SLVTRP3B.427 ! THE LAYER ABOVE THE CLOUD: ONLY ONE SET OF ALPHAS IS NOW NEEDED. SLVTRP3B.428 ! SLVTRP3B.429 I=N_CLOUD_TOP-1 SLVTRP3B.430 ! SLVTRP3B.431 IF (N_CLOUD_TOP.LT.N_LAYER) THEN SLVTRP3B.432 ! IF THERE IS NO CLOUD IN THE COLUMN THE V'S WILL NOT BE SLVTRP3B.433 ! ASSIGNED SO AN IF TEST IS REQUIRED. SLVTRP3B.434 THETA(1,1,I)=ALPHA(1,1,I+1)*UV(1,I,L) SLVTRP3B.435 & +ALPHA(1,2,I+1)*UV(2,I,L) SLVTRP3B.436 & +ALPHA(1,3,I+1)*UV(3,I,L) SLVTRP3B.437 ELSE SLVTRP3B.438 THETA(1,1,I)=ALPHA(1,1,I+1) SLVTRP3B.439 ENDIF SLVTRP3B.440 ! SLVTRP3B.441 BETA(1,1,I)=1.0E+00/(1.0E+00-THETA(1,1,I)*T_R(4,I,L)) SLVTRP3B.442 GAMMA(1,1,I)=THETA(1,1,I)*T_R(1,I,L) SLVTRP3B.443 H(1,I)=G(1,I+1)+THETA(1,1,I)*T_R(7,I,L) SLVTRP3B.444 ! SLVTRP3B.445 LAMBDA(0,I)=T_R(1,I,L)*BETA(1,1,I) SLVTRP3B.446 ALPHA(1,1,I)=T_R(4,I,L)+LAMBDA(0,I)*GAMMA(1,1,I) SLVTRP3B.447 G(1,I)=T_R(8,I,L)+LAMBDA(0,I)*H(1,I) SLVTRP3B.448 ! SLVTRP3B.449 ! SLVTRP3B.450 DO I=N_CLOUD_TOP-2, 1, -1 SLVTRP3B.451 ! SLVTRP3B.452 BETA(1,1,I)=1.0E+00/(1.0E+00-ALPHA(1,1,I+1)*T_R(4,I,L)) SLVTRP3B.453 GAMMA(1,1,I)=ALPHA(1,1,I+1)*T_R(1,I,L) SLVTRP3B.454 H(1,I)=G(1,I+1)+ALPHA(1,1,I+1)*T_R(7,I,L) SLVTRP3B.455 ! SLVTRP3B.456 LAMBDA(1,I)=T_R(1,I,L)*BETA(1,1,I) SLVTRP3B.457 ALPHA(1,1,I)=T_R(4,I,L)+LAMBDA(1,I)*GAMMA(1,1,I) SLVTRP3B.458 G(1,I)=T_R(8,I,L)+LAMBDA(1,I)*H(1,I) SLVTRP3B.459 ! SLVTRP3B.460 ENDDO SLVTRP3B.461 SLVTRP3B.462 ! SLVTRP3B.463 ! SLVTRP3B.464 ! INITIALIZE FOR DOWNWARD BACK-SUBSTITUTION. SLVTRP3B.465 FLUX_TOTAL(L, 2)=FLUX_INC_DOWN(L) SLVTRP3B.466 FLUX_TOTAL(L, 1)=ALPHA(1,1,1)*FLUX_TOTAL(L, 2)+G(1,1) SLVTRP3B.467 ! SLVTRP3B.468 ! SWEEP DOWNWARD THROUGH THE CLEAR-SKY REGION, FINDING THE DOWNWARD SLVTRP3B.469 ! FLUX AT THE TOP OF THE LAYER AND THE UPWARD FLUX AT THE BOTTOM. SLVTRP3B.470 DO I=1, N_CLOUD_TOP-1 SLVTRP3B.471 FLUX_TOTAL(L, 2*I+1)=(GAMMA(1,1,I)*FLUX_TOTAL(L, 2*I) SLVTRP3B.472 & +H(1,I))*BETA(1,1,I) SLVTRP3B.473 FLUX_TOTAL(L, 2*I+2)=T_R(1,I,L)*FLUX_TOTAL(L, 2*I) SLVTRP3B.474 & +T_R(4,I,L)*FLUX_TOTAL(L, 2*I+1)+T_R(7,I,L) SLVTRP3B.475 ENDDO SLVTRP3B.476 ! SLVTRP3B.477 ! PASS INTO THE TOP CLOUDY LAYER. USE FLUX_DOWN_[1,2,3] TO HOLD, SLVTRP3B.478 ! PROVISIONALLY, THE DOWNWARD FLUXES JUST BELOW THE TOP OF THE SLVTRP3B.479 ! LAYER, THEN CALCULATE THE UPWARD FLUXES AT THE BOTTOM AND SLVTRP3B.480 ! FINALLY THE DOWNWARD FLUXES AT THE BOTTOM OF THE LAYER. SLVTRP3B.481 I=N_CLOUD_TOP SLVTRP3B.482 FLUX_TEMP(1,I)=UV(1,I-1,L)*FLUX_TOTAL(L, 2*I) SLVTRP3B.483 FLUX_TEMP(2,I)=UV(2,I-1,L)*FLUX_TOTAL(L, 2*I) SLVTRP3B.484 FLUX_TEMP(3,I)=UV(3,I-1,L)*FLUX_TOTAL(L, 2*I) SLVTRP3B.485 FLUX_TEMP(4,I)=(GAMMA(1,1,I)*FLUX_TEMP(1,I) SLVTRP3B.486 & +GAMMA(1,2,I)*FLUX_TEMP(2,I) SLVTRP3B.487 & +GAMMA(1,3,I)*FLUX_TEMP(3,I) SLVTRP3B.488 & +H(1,I))*BETA(1,1,I) SLVTRP3B.489 FLUX_TEMP(5,I)=(GAMMA(2,1,I)*FLUX_TEMP(1,I) SLVTRP3B.490 & +GAMMA(2,2,I)*FLUX_TEMP(2,I) SLVTRP3B.491 & +GAMMA(2,3,I)*FLUX_TEMP(3,I)+H(2,I) SLVTRP3B.492 & -BETA(2,1,I)*FLUX_TEMP(4,I))*BETA(2,2,I) SLVTRP3B.493 FLUX_TEMP(6,I)=(GAMMA(3,1,I)*FLUX_TEMP(1,I) SLVTRP3B.494 & +GAMMA(3,2,I)*FLUX_TEMP(2,I) SLVTRP3B.495 & +GAMMA(3,3,I)*FLUX_TEMP(3,I)+H(3,I) SLVTRP3B.496 & -BETA(3,1,I)*FLUX_TEMP(4,I)-BETA(3,2,I)*FLUX_TEMP(5,I)) SLVTRP3B.497 & *BETA(3,3,I) SLVTRP3B.498 FLUX_TEMP(1,I)=T_R(1,I,L)*FLUX_TEMP(1,I) SLVTRP3B.499 & +T_R(4,I,L)*FLUX_TEMP(4,I)+T_R(7,I,L) SLVTRP3B.500 FLUX_TEMP(2,I)=T_R(2,I,L)*FLUX_TEMP(2,I) SLVTRP3B.501 & +T_R(5,I,L)*FLUX_TEMP(5,I)+T_R(9,I,L) SLVTRP3B.502 FLUX_TEMP(3,I)=T_R(3,I,L)*FLUX_TEMP(3,I) SLVTRP3B.503 & +T_R(6,I,L)*FLUX_TEMP(6,I)+T_R(11,I,L) SLVTRP3B.504 ! SLVTRP3B.505 ! THE MAIN LOOP OF BACK-SUBSTITUTION. THE PROVISIONAL USE OF THE SLVTRP3B.506 ! DOWNWARD FLUXES IS AS ABOVE. SLVTRP3B.507 DO I=N_CLOUD_TOP+1, N_LAYER SLVTRP3B.508 FLUX_TEMP(1,I)=UV(1,I-1,L)*FLUX_TEMP(1,I-1) SLVTRP3B.509 & +UV(4,I-1,L)*FLUX_TEMP(2,I-1) SLVTRP3B.510 & +UV(7,I-1,L)*FLUX_TEMP(3,I-1) SLVTRP3B.511 FLUX_TEMP(2,I)=UV(2,I-1,L)*FLUX_TEMP(1,I-1) SLVTRP3B.512 & +UV(5,I-1,L)*FLUX_TEMP(2,I-1) SLVTRP3B.513 & +UV(8,I-1,L)*FLUX_TEMP(3,I-1) SLVTRP3B.514 FLUX_TEMP(3,I)=UV(3,I-1,l)*FLUX_TEMP(1,I-1) SLVTRP3B.515 & +UV(6,I-1,L)*FLUX_TEMP(2,I-1) SLVTRP3B.516 & +UV(9,I-1,L)*FLUX_TEMP(3,I-1) SLVTRP3B.517 FLUX_TEMP(4,I)=(GAMMA(1,1,I)*FLUX_TEMP(1,I) SLVTRP3B.518 & +GAMMA(1,2,I)*FLUX_TEMP(2,I) SLVTRP3B.519 & +GAMMA(1,3,I)*FLUX_TEMP(3,I) SLVTRP3B.520 & +H(1,I))*BETA(1,1,I) SLVTRP3B.521 FLUX_TEMP(5,I)=(GAMMA(2,1,I)*FLUX_TEMP(1,I) SLVTRP3B.522 & +GAMMA(2,2,I)*FLUX_TEMP(2,I) SLVTRP3B.523 & +GAMMA(2,3,I)*FLUX_TEMP(3,I)+H(2,I) SLVTRP3B.524 & -BETA(2,1,I)*FLUX_TEMP(4,I))*BETA(2,2,I) SLVTRP3B.525 FLUX_TEMP(6,I)=(GAMMA(3,1,I)*FLUX_TEMP(1,I) SLVTRP3B.526 & +GAMMA(3,2,I)*FLUX_TEMP(2,I) SLVTRP3B.527 & +GAMMA(3,3,I)*FLUX_TEMP(3,I)+H(3,I) SLVTRP3B.528 & -BETA(3,1,I)*FLUX_TEMP(4,I) SLVTRP3B.529 & -BETA(3,2,I)*FLUX_TEMP(5,I)) SLVTRP3B.530 & *BETA(3,3,I) SLVTRP3B.531 FLUX_TEMP(1,I)=T_R(1,I,L)*FLUX_TEMP(1,I) SLVTRP3B.532 & +T_R(4,I,L)*FLUX_TEMP(4,I)+T_R(7,I,L) SLVTRP3B.533 FLUX_TEMP(2,I)=T_R(2,I,L)*FLUX_TEMP(2,I) SLVTRP3B.534 & +T_R(5,I,L)*FLUX_TEMP(5,I)+T_R(9,I,L) SLVTRP3B.535 FLUX_TEMP(3,I)=T_R(3,I,L)*FLUX_TEMP(3,I) SLVTRP3B.536 & +T_R(6,I,L)*FLUX_TEMP(6,I)+T_R(11,I,L) SLVTRP3B.537 ENDDO SLVTRP3B.538 SLVTRP3B.539 SLVTRP3B.540 ! SLVTRP3B.541 ! SLVTRP3B.542 ! CALCULATE THE OVERALL FLUX. SLVTRP3B.543 DO I=N_CLOUD_TOP, N_LAYER SLVTRP3B.544 FLUX_TOTAL(L, 2*I+1)=FLUX_TEMP(4,I)+FLUX_TEMP(5,I) SLVTRP3B.545 & +FLUX_TEMP(6,I) SLVTRP3B.546 FLUX_TOTAL(L, 2*I+2)=FLUX_TEMP(1,I)+FLUX_TEMP(2,I) SLVTRP3B.547 & +FLUX_TEMP(3,I) SLVTRP3B.548 ENDDO SLVTRP3B.549 SLVTRP3B.550 END DO SLVTRP3B.551 ! SLVTRP3B.552 ! REDUCE TO NET FLUXES IF REQUIRED. SLVTRP3B.553 IF (L_NET) THEN SLVTRP3B.554 DO I=0, N_LAYER SLVTRP3B.555 DO L=1, N_PROFILE SLVTRP3B.556 FLUX_TOTAL(L, I+1) SLVTRP3B.557 & =FLUX_TOTAL(L, 2*I+2)-FLUX_TOTAL(L, 2*I+1) SLVTRP3B.558 ENDDO SLVTRP3B.559 ENDDO SLVTRP3B.560 ENDIF SLVTRP3B.561 ! SLVTRP3B.562 RETURN SLVTRP3B.563 END SLVTRP3B.564 *ENDIF DEF,A01_3A,OR,DEF,A02_3A SLVTRP3B.565 *ENDIF DEF,A70_1B SLVTRP3B.566