*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.53 *IF DEF,A01_3A,OR,DEF,A02_3A MXMTE3A.2 C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13535 C GTS2F400.13536 C Use, duplication or disclosure of this code is subject to the GTS2F400.13537 C restrictions as set forth in the contract. GTS2F400.13538 C GTS2F400.13539 C Meteorological Office GTS2F400.13540 C London Road GTS2F400.13541 C BRACKNELL GTS2F400.13542 C Berkshire UK GTS2F400.13543 C RG12 2SZ GTS2F400.13544 C GTS2F400.13545 C If no contract has been raised with this copy of the code, the use, GTS2F400.13546 C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13547 C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13548 C Modelling at the above address. GTS2F400.13549 C ******************************COPYRIGHT****************************** GTS2F400.13550 C GTS2F400.13551 !+ Subroutine to set the coefficients of the endekadiagonal matrix. MXMTE3A.3 ! MXMTE3A.4 ! Method: MXMTE3A.5 ! Straightforward. MXMTE3A.6 ! MXMTE3A.7 ! Current Owner of Code: J. M. Edwards MXMTE3A.8 ! MXMTE3A.9 ! History: MXMTE3A.10 ! Version Date Comment MXMTE3A.11 ! 4.0 27-07-95 Original Code MXMTE3A.12 ! (J. M. Edwards) MXMTE3A.13 ! MXMTE3A.14 ! Description of Code: MXMTE3A.15 ! FORTRAN 77 with extensions listed in documentation. MXMTE3A.16 ! MXMTE3A.17 !- --------------------------------------------------------------------- MXMTE3A.18SUBROUTINE MIX_MATRIX_ELEM(N_PROFILE, N_LAYER, N_CLOUD_TOP 1MXMTE3A.19 & , T_FREE, R_FREE, S_DOWN_FREE, S_UP_FREE MXMTE3A.20 & , T_CLOUD, R_CLOUD, S_DOWN_CLOUD, S_UP_CLOUD MXMTE3A.21 & , G_M, G_P, B_M, B_P MXMTE3A.22 & , FLUX_INC_DOWN MXMTE3A.23 & , SOURCE_GROUND, ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR MXMTE3A.24 & , FLUX_DIRECT_GROUND MXMTE3A.25 & , A, B MXMTE3A.26 & , NPD_PROFILE, NPD_LAYER MXMTE3A.27 & ) MXMTE3A.28 ! MXMTE3A.29 ! MXMTE3A.30 ! MXMTE3A.31 IMPLICIT NONE MXMTE3A.32 ! MXMTE3A.33 ! MXMTE3A.34 ! SIZES OF DUMMY ARRAYS. MXMTE3A.35 INTEGER !, INTENT(IN) MXMTE3A.36 & NPD_PROFILE MXMTE3A.37 ! MAXIMUM NUMBER OF PROFILES MXMTE3A.38 & , NPD_LAYER MXMTE3A.39 ! MAXIMUM NUMBER OF LAYERS MXMTE3A.40 ! MXMTE3A.41 ! MXMTE3A.42 ! DUMMY ARGUMENTS. MXMTE3A.43 INTEGER !, INTENT(IN) MXMTE3A.44 & N_PROFILE MXMTE3A.45 & , N_LAYER MXMTE3A.46 & , N_CLOUD_TOP MXMTE3A.47 REAL !, INTENT(IN) MXMTE3A.48 & T_FREE(NPD_PROFILE, NPD_LAYER) MXMTE3A.49 & , R_FREE(NPD_PROFILE, NPD_LAYER) MXMTE3A.50 & , S_DOWN_FREE(NPD_PROFILE, NPD_LAYER) MXMTE3A.51 & , S_UP_FREE(NPD_PROFILE, NPD_LAYER) MXMTE3A.52 & , T_CLOUD(NPD_PROFILE, NPD_LAYER) MXMTE3A.53 & , R_CLOUD(NPD_PROFILE, NPD_LAYER) MXMTE3A.54 & , S_DOWN_CLOUD(NPD_PROFILE, NPD_LAYER) MXMTE3A.55 & , S_UP_CLOUD(NPD_PROFILE, NPD_LAYER) MXMTE3A.56 REAL !, INTENT(IN) MXMTE3A.57 & B_M(NPD_PROFILE, 0: NPD_LAYER) MXMTE3A.58 & , B_P(NPD_PROFILE, 0: NPD_LAYER) MXMTE3A.59 & , G_M(NPD_PROFILE, 0: NPD_LAYER) MXMTE3A.60 & , G_P(NPD_PROFILE, 0: NPD_LAYER) MXMTE3A.61 REAL !, INTENT(IN) MXMTE3A.62 & FLUX_INC_DOWN(NPD_PROFILE) MXMTE3A.63 & , SOURCE_GROUND(NPD_PROFILE) MXMTE3A.64 & , ALBEDO_SURFACE_DIFF(NPD_PROFILE) MXMTE3A.65 & , ALBEDO_SURFACE_DIR(NPD_PROFILE) MXMTE3A.66 & , FLUX_DIRECT_GROUND(NPD_PROFILE) MXMTE3A.67 REAL !, INTENT(OUT) MXMTE3A.68 & A(NPD_PROFILE, 11, 4*NPD_LAYER+4) MXMTE3A.69 & , B(NPD_PROFILE, 4*NPD_LAYER+4) MXMTE3A.70 ! MXMTE3A.71 ! LOCAL VARIABLES. MXMTE3A.72 INTEGER MXMTE3A.73 & I MXMTE3A.74 & , L MXMTE3A.75 REAL MXMTE3A.76 & TP(NPD_PROFILE, NPD_LAYER) MXMTE3A.77 & , TM(NPD_PROFILE, NPD_LAYER) MXMTE3A.78 & , RP(NPD_PROFILE, NPD_LAYER) MXMTE3A.79 & , RM(NPD_PROFILE, NPD_LAYER) MXMTE3A.80 ! MXMTE3A.81 ! MXMTE3A.82 ! MXMTE3A.83 ! PRECALCULATE THE MEAN SUMMED AND DIFFERENCED TRANSMISSIVITIES MXMTE3A.84 ! AND REFLECTION COEFFICIENTS FOR EFFICIENCY. MXMTE3A.85 DO I=N_CLOUD_TOP, N_LAYER MXMTE3A.86 DO L=1, N_PROFILE MXMTE3A.87 TP(L, I)=0.5E+00*(T_FREE(L, I)+T_CLOUD(L, I)) MXMTE3A.88 TM(L, I)=0.5E+00*(T_FREE(L, I)-T_CLOUD(L, I)) MXMTE3A.89 RP(L, I)=0.5E+00*(R_FREE(L, I)+R_CLOUD(L, I)) MXMTE3A.90 RM(L, I)=0.5E+00*(R_FREE(L, I)-R_CLOUD(L, I)) MXMTE3A.91 ENDDO MXMTE3A.92 ENDDO MXMTE3A.93 ! MXMTE3A.94 ! CONDITIONS ON THE DOWNWARD FLUX ENTERING THE TOP LAYER: MXMTE3A.95 DO L=1, N_PROFILE MXMTE3A.96 ! INCIDENT DIFFERENCE FLUX: MXMTE3A.97 A(L, 11, 3)=0.0E+00 MXMTE3A.98 A(L, 10, 3)=0.0E+00 MXMTE3A.99 A(L, 9, 3)=0.0E+00 MXMTE3A.100 A(L, 8, 3)=0.0E+00 MXMTE3A.101 A(L, 7, 3)=0.0E+00 MXMTE3A.102 A(L, 6, 3)=1.0E+00 MXMTE3A.103 A(L, 5, 3)=0.0E+00 MXMTE3A.104 A(L, 4, 3)=0.0E+00 MXMTE3A.105 A(L, 3, 3)=0.0E+00 MXMTE3A.106 A(L, 2, 3)=0.0E+00 MXMTE3A.107 A(L, 1, 3)=0.0E+00 MXMTE3A.108 B(L, 3)=FLUX_INC_DOWN(L) MXMTE3A.109 ! INCIDENT SUMMED FLUX: MXMTE3A.110 A(L, 11, 4)=0.0E+00 MXMTE3A.111 A(L, 10, 4)=0.0E+00 MXMTE3A.112 A(L, 9, 4)=0.0E+00 MXMTE3A.113 A(L, 8, 4)=0.0E+00 MXMTE3A.114 A(L, 7, 4)=0.0E+00 MXMTE3A.115 A(L, 6, 4)=1.0E+00 MXMTE3A.116 A(L, 5, 4)=0.0E+00 MXMTE3A.117 A(L, 4, 4)=0.0E+00 MXMTE3A.118 A(L, 3, 4)=0.0E+00 MXMTE3A.119 A(L, 2, 4)=0.0E+00 MXMTE3A.120 A(L, 1, 4)=0.0E+00 MXMTE3A.121 B(L, 4)=FLUX_INC_DOWN(L) MXMTE3A.122 ENDDO MXMTE3A.123 ! MXMTE3A.124 ! ASSIGN SETS OF EQUATIONS FOR EACH LAYER: MXMTE3A.125 DO I=1, N_CLOUD_TOP-1 MXMTE3A.126 DO L=1, N_PROFILE MXMTE3A.127 ! MXMTE3A.128 ! DIFFERENCE IN FLUXES JUST BELOW THE TOP OF THE LAYER: MXMTE3A.129 A(L, 11, 4*I-3)=0.0E+00 MXMTE3A.130 A(L, 10, 4*I-3)=0.0E+00 MXMTE3A.131 A(L, 9, 4*I-3)=0.0E+00 MXMTE3A.132 A(L, 8, 4*I-3)=0.0E+00 MXMTE3A.133 A(L, 7, 4*I-3)=0.0E+00 MXMTE3A.134 A(L, 6, 4*I-3)=-1.0E+00 MXMTE3A.135 A(L, 5, 4*I-3)=1.0E+00 MXMTE3A.136 A(L, 4, 4*I-3)=0.0E+00 MXMTE3A.137 A(L, 3, 4*I-3)=0.0E+00 MXMTE3A.138 A(L, 2, 4*I-3)=0.0E+00 MXMTE3A.139 A(L, 1, 4*I-3)=0.0E+00 MXMTE3A.140 B(L, 4*I-3)=0.0E+00 MXMTE3A.141 ! MXMTE3A.142 ! SUMMED FLUX AT THE TOP OF THE LAYER: MXMTE3A.143 A(L, 11, 4*I-2)=0.0E+00 MXMTE3A.144 A(L, 10, 4*I-2)=0.0E+00 MXMTE3A.145 A(L, 9, 4*I-2)=0.0E+00 MXMTE3A.146 A(L, 8, 4*I-2)=0.0E+00 MXMTE3A.147 A(L, 7, 4*I-2)=0.0E+00 MXMTE3A.148 A(L, 6, 4*I-2)=-1.0E+00 MXMTE3A.149 A(L, 5, 4*I-2)=0.0E+00 MXMTE3A.150 A(L, 4, 4*I-2)=R_FREE(L, I) MXMTE3A.151 A(L, 3, 4*I-2)=0.0E+00 MXMTE3A.152 A(L, 2, 4*I-2)=T_FREE(L, I) MXMTE3A.153 A(L, 1, 4*I-2)=0.0E+00 MXMTE3A.154 B(L, 4*I-2)=-S_UP_FREE(L, I) MXMTE3A.155 ! MXMTE3A.156 ! DIFFERENCE FLUX JUST ABOVE THE BASE OF THE LAYER: MXMTE3A.157 A(L, 11, 4*I+3)=0.0E+00 MXMTE3A.158 A(L, 10, 4*I+3)=0.0E+00 MXMTE3A.159 A(L, 9, 4*I+3)=0.0E+00 MXMTE3A.160 A(L, 8, 4*I+3)=0.0E+00 MXMTE3A.161 A(L, 7, 4*I+3)=0.0E+00 MXMTE3A.162 A(L, 6, 4*I+3)=-1.0E+00 MXMTE3A.163 A(L, 5, 4*I+3)=1.0E+00 MXMTE3A.164 A(L, 4, 4*I+3)=0.0E+00 MXMTE3A.165 A(L, 3, 4*I+3)=0.0E+00 MXMTE3A.166 A(L, 2, 4*I+3)=0.0E+00 MXMTE3A.167 A(L, 1, 4*I+3)=0.0E+00 MXMTE3A.168 B(L, 4*I+3)=0.0E+00 MXMTE3A.169 ! MXMTE3A.170 ! SUMMED FLUXES AT THE BASE OF THE LAYER: MXMTE3A.171 A(L, 11, 4*I+4)=0.0E+00 MXMTE3A.172 A(L, 10, 4*I+4)=T_FREE(L, I) MXMTE3A.173 A(L, 9, 4*I+4)=0.0E+00 MXMTE3A.174 A(L, 8, 4*I+4)=R_FREE(L, I) MXMTE3A.175 A(L, 7, 4*I+4)=0.0E+00 MXMTE3A.176 A(L, 6, 4*I+4)=-1.0E+00 MXMTE3A.177 A(L, 5, 4*I+4)=0.0E+00 MXMTE3A.178 A(L, 4, 4*I+4)=0.0E+00 MXMTE3A.179 A(L, 3, 4*I+4)=0.0E+00 MXMTE3A.180 A(L, 2, 4*I+4)=0.0E+00 MXMTE3A.181 A(L, 1, 4*I+4)=0.0E+00 MXMTE3A.182 B(L, 4*I+4)=-S_DOWN_FREE(L, I) MXMTE3A.183 ENDDO MXMTE3A.184 ENDDO MXMTE3A.185 DO I=N_CLOUD_TOP, N_LAYER MXMTE3A.186 DO L=1, N_PROFILE MXMTE3A.187 ! MXMTE3A.188 ! DIFFERENCE IN FLUXES JUST BELOW THE TOP OF THE LAYER: MXMTE3A.189 A(L, 11, 4*I-3)=0.0E+00 MXMTE3A.190 A(L, 10, 4*I-3)=0.0E+00 MXMTE3A.191 A(L, 9, 4*I-3)=0.0E+00 MXMTE3A.192 A(L, 8, 4*I-3)=0.0E+00 MXMTE3A.193 A(L, 7, 4*I-3)=0.0E+00 MXMTE3A.194 A(L, 6, 4*I-3)=-1.0E+00 MXMTE3A.195 A(L, 5, 4*I-3)=0.0E+00 MXMTE3A.196 A(L, 4, 4*I-3)=0.5E+00*G_M(L, I-1)*RP(L, I) MXMTE3A.197 A(L, 3, 4*I-3)=RM(L, I)+0.5E+00*G_P(L, I-1)*RP(L, I) MXMTE3A.198 A(L, 2, 4*I-3)=0.5E+00*B_M(L, I)*TP(L, I) MXMTE3A.199 A(L, 1, 4*I-3)=TM(L, I)+0.5E+00*B_P(L, I)*TP(L, I) MXMTE3A.200 B(L, 4*I-3)=-S_UP_FREE(L, I)+S_UP_CLOUD(L, I) MXMTE3A.201 ! MXMTE3A.202 ! SUMMED FLUX AT THE TOP OF THE LAYER: MXMTE3A.203 A(L, 11, 4*I-2)=0.0E+00 MXMTE3A.204 A(L, 10, 4*I-2)=0.0E+00 MXMTE3A.205 A(L, 9, 4*I-2)=0.0E+00 MXMTE3A.206 A(L, 8, 4*I-2)=0.0E+00 MXMTE3A.207 A(L, 7, 4*I-2)=0.0E+00 MXMTE3A.208 A(L, 6, 4*I-2)=-1.0E+00 MXMTE3A.209 A(L, 5, 4*I-2)=0.5E+00*G_M(L, I-1)*RM(L, I) MXMTE3A.210 A(L, 4, 4*I-2)=RP(L, I)+0.5E+00*G_P(L, I-1)*RM(L, I) MXMTE3A.211 A(L, 3, 4*I-2)=0.5E+00*B_M(L, I)*TM(L, I) MXMTE3A.212 A(L, 2, 4*I-2)=TP(L, I)+0.5E+00*B_P(L, I)*TM(L, I) MXMTE3A.213 A(L, 1, 4*I-2)=0.0E+00 MXMTE3A.214 B(L, 4*I-2)=-S_UP_FREE(L, I)-S_UP_CLOUD(L, I) MXMTE3A.215 ! MXMTE3A.216 ! DIFFERENCE FLUX JUST ABOVE THE BASE OF THE LAYER: MXMTE3A.217 A(L, 11, 4*I+3)=0.0E+00 MXMTE3A.218 A(L, 10, 4*I+3)=0.5E+00*G_M(L, I-1)*TP(L, I) MXMTE3A.219 A(L, 9, 4*I+3)=TM(L, I)+0.5E+00*G_P(L, I-1)*TP(L, I) MXMTE3A.220 A(L, 8, 4*I+3)=0.5E+00*B_M(L, I)*RP(L, I) MXMTE3A.221 A(L, 7, 4*I+3)=RM(L, I)+0.5E+00*B_P(L, I)*RP(L, I) MXMTE3A.222 A(L, 6, 4*I+3)=-1.0E+00 MXMTE3A.223 A(L, 5, 4*I+3)=0.0E+00 MXMTE3A.224 A(L, 4, 4*I+3)=0.0E+00 MXMTE3A.225 A(L, 3, 4*I+3)=0.0E+00 MXMTE3A.226 A(L, 2, 4*I+3)=0.0E+00 MXMTE3A.227 A(L, 1, 4*I+3)=0.0E+00 MXMTE3A.228 B(L, 4*I+3)=-S_DOWN_FREE(L, I)+S_DOWN_CLOUD(L, I) MXMTE3A.229 ! MXMTE3A.230 ! SUMMED FLUXES AT THE BASE OF THE LAYER: MXMTE3A.231 A(L, 11, 4*I+4)=0.5E+00*G_M(L, I-1)*TM(L, I) MXMTE3A.232 A(L, 10, 4*I+4)=TP(L, I)+0.5E+00*G_P(L, I-1)*TM(L, I) MXMTE3A.233 A(L, 9, 4*I+4)=0.5E+00*B_M(L, I)*RM(L, I) MXMTE3A.234 A(L, 8, 4*I+4)=RP(L, I)+0.5E+00*B_P(L, I)*RM(L, I) MXMTE3A.235 A(L, 7, 4*I+4)=0.0E+00 MXMTE3A.236 A(L, 6, 4*I+4)=-1.0E+00 MXMTE3A.237 A(L, 5, 4*I+4)=0.0E+00 MXMTE3A.238 A(L, 4, 4*I+4)=0.0E+00 MXMTE3A.239 A(L, 3, 4*I+4)=0.0E+00 MXMTE3A.240 A(L, 2, 4*I+4)=0.0E+00 MXMTE3A.241 A(L, 1, 4*I+4)=0.0E+00 MXMTE3A.242 B(L, 4*I+4)=-S_DOWN_FREE(L, I)-S_DOWN_CLOUD(L, I) MXMTE3A.243 ! MXMTE3A.244 ENDDO MXMTE3A.245 ENDDO MXMTE3A.246 ! MXMTE3A.247 ! CONDITIONS AT THE SURFACE: MXMTE3A.248 DO L=1, N_PROFILE MXMTE3A.249 ! MXMTE3A.250 A(L, 11, 4*N_LAYER+1)=0.0E+00 MXMTE3A.251 A(L, 10, 4*N_LAYER+1)=0.0E+00 MXMTE3A.252 A(L, 9, 4*N_LAYER+1)=0.0E+00 MXMTE3A.253 A(L, 8, 4*N_LAYER+1)=0.0E+00 MXMTE3A.254 A(L, 7, 4*N_LAYER+1)=0.0E+00 MXMTE3A.255 A(L, 6, 4*N_LAYER+1)=1.0E+00 MXMTE3A.256 A(L, 5, 4*N_LAYER+1)=-1.0E+00 MXMTE3A.257 A(L, 4, 4*N_LAYER+1)=0.0E+00 MXMTE3A.258 A(L, 3, 4*N_LAYER+1)=0.0E+00 MXMTE3A.259 A(L, 2, 4*N_LAYER+1)=0.0E+00 MXMTE3A.260 A(L, 1, 4*N_LAYER+1)=0.0E+00 MXMTE3A.261 B(L, 4*N_LAYER+1)=0.0E+00 MXMTE3A.262 ! MXMTE3A.263 A(L, 11, 4*N_LAYER+2)=0.0E+00 MXMTE3A.264 A(L, 10, 4*N_LAYER+2)=0.0E+00 MXMTE3A.265 A(L, 9, 4*N_LAYER+2)=0.0E+00 MXMTE3A.266 A(L, 8, 4*N_LAYER+2)=0.0E+00 MXMTE3A.267 A(L, 7, 4*N_LAYER+2)=0.0E+00 MXMTE3A.268 A(L, 6, 4*N_LAYER+2)=1.0E+00 MXMTE3A.269 A(L, 5, 4*N_LAYER+2)=0.0E+00 MXMTE3A.270 A(L, 4, 4*N_LAYER+2)=-ALBEDO_SURFACE_DIFF(L) MXMTE3A.271 A(L, 3, 4*N_LAYER+2)=0.0E+00 MXMTE3A.272 A(L, 2, 4*N_LAYER+2)=0.0E+00 MXMTE3A.273 A(L, 1, 4*N_LAYER+2)=0.0E+00 MXMTE3A.274 B(L, 4*N_LAYER+2)=SOURCE_GROUND(L) MXMTE3A.275 & +(ALBEDO_SURFACE_DIR(L)-ALBEDO_SURFACE_DIFF(L)) MXMTE3A.276 & *FLUX_DIRECT_GROUND(L) MXMTE3A.277 ENDDO MXMTE3A.278 ! MXMTE3A.279 ! MXMTE3A.280 ! MXMTE3A.281 RETURN MXMTE3A.282 END MXMTE3A.283 *ENDIF DEF,A01_3A,OR,DEF,A02_3A MXMTE3A.284 *ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.54