| 1 | MODULE sedmat |
|---|
| 2 | !!====================================================================== |
|---|
| 3 | !! *** MODULE sedmat *** |
|---|
| 4 | !! Sediment : linear system of equations |
|---|
| 5 | !!===================================================================== |
|---|
| 6 | !! * Modules used |
|---|
| 7 | !!---------------------------------------------------------------------- |
|---|
| 8 | |
|---|
| 9 | USE sed ! sediment global variable |
|---|
| 10 | USE lib_mpp ! distribued memory computing library |
|---|
| 11 | |
|---|
| 12 | |
|---|
| 13 | IMPLICIT NONE |
|---|
| 14 | PRIVATE |
|---|
| 15 | |
|---|
| 16 | PUBLIC sed_mat_dsr |
|---|
| 17 | PUBLIC sed_mat_dsrjac |
|---|
| 18 | PUBLIC sed_mat_dsri |
|---|
| 19 | PUBLIC sed_mat_btb |
|---|
| 20 | |
|---|
| 21 | INTEGER, PARAMETER :: nmax = 60 |
|---|
| 22 | |
|---|
| 23 | |
|---|
| 24 | !! $Id$ |
|---|
| 25 | CONTAINS |
|---|
| 26 | |
|---|
| 27 | SUBROUTINE sed_mat_dsr( ji, nvar, dtsed_in ) |
|---|
| 28 | !!--------------------------------------------------------------------- |
|---|
| 29 | !! *** ROUTINE sed_mat_dsr *** |
|---|
| 30 | !! |
|---|
| 31 | !! ** Purpose : solves tridiagonal system of linear equations |
|---|
| 32 | !! |
|---|
| 33 | !! ** Method : |
|---|
| 34 | !! 1 - computes left hand side of linear system of equations |
|---|
| 35 | !! for dissolution reaction |
|---|
| 36 | !! For mass balance in kbot+sediment : |
|---|
| 37 | !! dz3d (:,1) = dz(1) = 0.5 cm |
|---|
| 38 | !! volw3d(:,1) = dzkbot ( see sedini.F90 ) |
|---|
| 39 | !! dz(2) = 0.3 cm |
|---|
| 40 | !! dz3d(:,2) = 0.3 + dzdep ( see seddsr.F90 ) |
|---|
| 41 | !! volw3d(:,2) and vols3d(l,2) are thickened ( see seddsr.F90 ) |
|---|
| 42 | !! |
|---|
| 43 | !! 2 - forward/backward substitution. |
|---|
| 44 | !! |
|---|
| 45 | !! History : |
|---|
| 46 | !! ! 04-10 (N. Emprin, M. Gehlen ) original |
|---|
| 47 | !! ! 06-04 (C. Ethe) Module Re-organization |
|---|
| 48 | !!---------------------------------------------------------------------- |
|---|
| 49 | !! * Arguments |
|---|
| 50 | INTEGER , INTENT(in) :: ji, nvar ! number of variable |
|---|
| 51 | |
|---|
| 52 | REAL(wp), INTENT(in) :: dtsed_in |
|---|
| 53 | |
|---|
| 54 | !---Local declarations |
|---|
| 55 | INTEGER :: jk, jn |
|---|
| 56 | REAL(wp), DIMENSION(jpksed) :: za, zb, zc |
|---|
| 57 | |
|---|
| 58 | REAL(wp) :: aplus,aminus |
|---|
| 59 | REAL(wp) :: rplus,rminus |
|---|
| 60 | REAL(wp) :: dxplus,dxminus |
|---|
| 61 | |
|---|
| 62 | !---------------------------------------------------------------------- |
|---|
| 63 | |
|---|
| 64 | IF( ln_timing ) CALL timing_start('sed_mat_dsr') |
|---|
| 65 | |
|---|
| 66 | ! Computation left hand side of linear system of |
|---|
| 67 | ! equations for dissolution reaction |
|---|
| 68 | !--------------------------------------------- |
|---|
| 69 | |
|---|
| 70 | |
|---|
| 71 | jn = nvar |
|---|
| 72 | ! first sediment level |
|---|
| 73 | aplus = ( por(1) + por(2) ) * 0.5 |
|---|
| 74 | dxplus = ( dz3d(ji,1) + dz3d(ji,2) ) / 2. |
|---|
| 75 | rplus = ( dtsed_in / ( volw3d(ji,1) ) ) * diff(ji,1,jn) * aplus / dxplus |
|---|
| 76 | |
|---|
| 77 | za(1) = 0. |
|---|
| 78 | zb(1) = rplus |
|---|
| 79 | zc(1) = -rplus |
|---|
| 80 | |
|---|
| 81 | DO jk = 2, jpksed - 1 |
|---|
| 82 | aminus = ( por(jk-1) + por(jk) ) * 0.5 |
|---|
| 83 | dxminus = ( dz3d(ji,jk-1) + dz3d(ji,jk) ) / 2. |
|---|
| 84 | |
|---|
| 85 | aplus = ( por(jk+1) + por(jk) ) * 0.5 |
|---|
| 86 | dxplus = ( dz3d(ji,jk) + dz3d(ji,jk+1) ) / 2 |
|---|
| 87 | ! |
|---|
| 88 | rminus = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk-1,jn) * aminus / dxminus |
|---|
| 89 | rplus = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk,jn) * aplus / dxplus |
|---|
| 90 | ! |
|---|
| 91 | za(jk) = -rminus |
|---|
| 92 | zb(jk) = rminus + rplus |
|---|
| 93 | zc(jk) = -rplus |
|---|
| 94 | END DO |
|---|
| 95 | |
|---|
| 96 | aminus = ( por(jpksed-1) + por(jpksed) ) * 0.5 |
|---|
| 97 | dxminus = ( dz3d(ji,jpksed-1) + dz3d(ji,jpksed) ) / 2. |
|---|
| 98 | rminus = ( dtsed_in / volw3d(ji,jpksed) ) * diff(ji,jpksed-1,jn) * aminus / dxminus |
|---|
| 99 | ! |
|---|
| 100 | za(jpksed) = -rminus |
|---|
| 101 | zb(jpksed) = rminus |
|---|
| 102 | zc(jpksed) = 0. |
|---|
| 103 | |
|---|
| 104 | ! solves tridiagonal system of linear equations |
|---|
| 105 | ! ----------------------------------------------- |
|---|
| 106 | |
|---|
| 107 | pwcpa(ji,1,jn) = pwcpa(ji,1,jn) - ( zc(1) * pwcp(ji,2,jn) + zb(1) * pwcp(ji,1,jn) ) |
|---|
| 108 | DO jk = 2, jpksed - 1 |
|---|
| 109 | pwcpa(ji,jk,jn) = pwcpa(ji,jk,jn) - ( zc(jk) * pwcp(ji,jk+1,jn) + za(jk) * pwcp(ji,jk-1,jn) & |
|---|
| 110 | & + zb(jk) * pwcp(ji,jk,jn) ) |
|---|
| 111 | ENDDO |
|---|
| 112 | pwcpa(ji,jpksed,jn) = pwcpa(ji,jpksed,jn) - ( za(jk) * pwcp(ji,jk-1,jn) + zb(jk) * pwcp(ji,jk,jn) ) |
|---|
| 113 | |
|---|
| 114 | IF( ln_timing ) CALL timing_stop('sed_mat_dsr') |
|---|
| 115 | |
|---|
| 116 | END SUBROUTINE sed_mat_dsr |
|---|
| 117 | |
|---|
| 118 | SUBROUTINE sed_mat_dsrjac( ji, nvar, dtsed_in ) |
|---|
| 119 | !!--------------------------------------------------------------------- |
|---|
| 120 | !! *** ROUTINE sed_mat_dsrjac *** |
|---|
| 121 | !! |
|---|
| 122 | !! ** Purpose : solves tridiagonal system of linear equations |
|---|
| 123 | !! |
|---|
| 124 | !! ** Method : |
|---|
| 125 | !! 1 - computes left hand side of linear system of equations |
|---|
| 126 | !! for dissolution reaction |
|---|
| 127 | !! For mass balance in kbot+sediment : |
|---|
| 128 | !! dz3d (:,1) = dz(1) = 0.5 cm |
|---|
| 129 | !! volw3d(:,1) = dzkbot ( see sedini.F90 ) |
|---|
| 130 | !! dz(2) = 0.3 cm |
|---|
| 131 | !! dz3d(:,2) = 0.3 + dzdep ( see seddsr.F90 ) |
|---|
| 132 | !! volw3d(:,2) and vols3d(l,2) are thickened ( see |
|---|
| 133 | !seddsr.F90 ) |
|---|
| 134 | !! |
|---|
| 135 | !! 2 - forward/backward substitution. |
|---|
| 136 | !! |
|---|
| 137 | !! History : |
|---|
| 138 | !! ! 04-10 (N. Emprin, M. Gehlen ) original |
|---|
| 139 | !! ! 06-04 (C. Ethe) Module Re-organization |
|---|
| 140 | !!---------------------------------------------------------------------- |
|---|
| 141 | !! * Arguments |
|---|
| 142 | INTEGER , INTENT(in) :: ji, nvar ! number of variable |
|---|
| 143 | |
|---|
| 144 | REAL(wp), INTENT(in) :: dtsed_in |
|---|
| 145 | |
|---|
| 146 | !---Local declarations |
|---|
| 147 | INTEGER :: jk, jn, jnn |
|---|
| 148 | REAL(wp), DIMENSION(jpksed) :: za, zb, zc |
|---|
| 149 | |
|---|
| 150 | REAL(wp) :: aplus,aminus |
|---|
| 151 | REAL(wp) :: rplus,rminus |
|---|
| 152 | REAL(wp) :: dxplus,dxminus |
|---|
| 153 | |
|---|
| 154 | !---------------------------------------------------------------------- |
|---|
| 155 | |
|---|
| 156 | IF( ln_timing ) CALL timing_start('sed_mat_dsrjac') |
|---|
| 157 | |
|---|
| 158 | ! Computation left hand side of linear system of |
|---|
| 159 | ! equations for dissolution reaction |
|---|
| 160 | !--------------------------------------------- |
|---|
| 161 | |
|---|
| 162 | |
|---|
| 163 | jn = nvar |
|---|
| 164 | ! first sediment level |
|---|
| 165 | aplus = ( por(1) + por(2) ) *0.5 |
|---|
| 166 | dxplus = ( dz3d(ji,1) + dz3d(ji,2) ) / 2. |
|---|
| 167 | rplus = ( dtsed_in / ( volw3d(ji,1) ) ) * diff(ji,1,jn) * aplus / dxplus |
|---|
| 168 | |
|---|
| 169 | za(1) = 0. |
|---|
| 170 | zb(1) = rplus |
|---|
| 171 | zc(1) = -rplus |
|---|
| 172 | |
|---|
| 173 | DO jk = 2, jpksed - 1 |
|---|
| 174 | aminus = ( por(jk-1) + por(jk) ) * 0.5 |
|---|
| 175 | dxminus = ( dz3d(ji,jk-1) + dz3d(ji,jk) ) / 2. |
|---|
| 176 | |
|---|
| 177 | aplus = ( por(jk+1) + por(jk) ) * 0.5 |
|---|
| 178 | dxplus = ( dz3d(ji,jk) + dz3d(ji,jk+1) ) / 2 |
|---|
| 179 | ! |
|---|
| 180 | rminus = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk-1,jn) * aminus / dxminus |
|---|
| 181 | rplus = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk,jn) * aplus / dxplus |
|---|
| 182 | ! |
|---|
| 183 | za(jk) = -rminus |
|---|
| 184 | zb(jk) = rminus + rplus |
|---|
| 185 | zc(jk) = -rplus |
|---|
| 186 | END DO |
|---|
| 187 | |
|---|
| 188 | aminus = ( por(jpksed-1) + por(jpksed) ) * 0.5 |
|---|
| 189 | dxminus = ( dz3d(ji,jpksed-1) + dz3d(ji,jpksed) ) / 2. |
|---|
| 190 | rminus = ( dtsed_in / volw3d(ji,jpksed) ) * diff(ji,jpksed-1,jn) * aminus / dxminus |
|---|
| 191 | ! |
|---|
| 192 | za(jpksed) = -rminus |
|---|
| 193 | zb(jpksed) = rminus |
|---|
| 194 | zc(jpksed) = 0. |
|---|
| 195 | |
|---|
| 196 | ! solves tridiagonal system of linear equations |
|---|
| 197 | |
|---|
| 198 | IF (isvode(jn) > 0) THEN |
|---|
| 199 | jnn = isvode(jn) |
|---|
| 200 | Jacobian(ji, jnn, jnn) = Jacobian(ji,jnn,jnn) - zb(1) |
|---|
| 201 | Jacobian(ji, jnn, jpvode + jnn) = Jacobian(ji, jnn, jpvode + jnn) -zc(1) |
|---|
| 202 | DO jk = 2, jpksed - 1 |
|---|
| 203 | Jacobian(ji, (jk-1) * jpvode + jnn, (jk-2) * jpvode + jnn) = Jacobian(ji, (jk-1) * jpvode + jnn, (jk-2) * jpvode + jnn) - za(jk) |
|---|
| 204 | Jacobian(ji, (jk-1) * jpvode + jnn, (jk-1) * jpvode + jnn) = Jacobian(ji, (jk-1) * jpvode + jnn, (jk-1) * jpvode + jnn) - zb(jk) |
|---|
| 205 | Jacobian(ji, (jk-1) * jpvode + jnn, (jk) * jpvode + jnn) = Jacobian(ji, (jk-1) * jpvode + jnn, (jk) * jpvode + jnn) - zc(jk) |
|---|
| 206 | END DO |
|---|
| 207 | Jacobian(ji, (jpksed-1) * jpvode + jnn, (jpksed-2) * jpvode + jnn) = Jacobian(ji, (jpksed-1) * jpvode + jnn, (jpksed-2) * jpvode + jnn) - za(jpksed) |
|---|
| 208 | Jacobian(ji, (jpksed-1) * jpvode + jnn, (jpksed-1) * jpvode + jnn) = Jacobian(ji, (jpksed-1) * jpvode + jnn, (jpksed-1) * jpvode + jnn) - zb(jpksed) |
|---|
| 209 | ENDIF |
|---|
| 210 | |
|---|
| 211 | IF( ln_timing ) CALL timing_stop('sed_mat_dsrjac') |
|---|
| 212 | |
|---|
| 213 | END SUBROUTINE sed_mat_dsrjac |
|---|
| 214 | |
|---|
| 215 | |
|---|
| 216 | |
|---|
| 217 | |
|---|
| 218 | SUBROUTINE sed_mat_btb( nlev, nvar, psol, preac, dtsed_in ) |
|---|
| 219 | !!--------------------------------------------------------------------- |
|---|
| 220 | !! *** ROUTINE sed_mat_btb *** |
|---|
| 221 | !! |
|---|
| 222 | !! ** Purpose : solves tridiagonal system of linear equations |
|---|
| 223 | !! |
|---|
| 224 | !! ** Method : |
|---|
| 225 | !! 1 - computes left hand side of linear system of equations |
|---|
| 226 | !! for dissolution reaction |
|---|
| 227 | !! |
|---|
| 228 | !! 2 - forward/backward substitution. |
|---|
| 229 | !! |
|---|
| 230 | !! History : |
|---|
| 231 | !! ! 04-10 (N. Emprin, M. Gehlen ) original |
|---|
| 232 | !! ! 06-04 (C. Ethe) Module Re-organization |
|---|
| 233 | !!---------------------------------------------------------------------- |
|---|
| 234 | !! * Arguments |
|---|
| 235 | INTEGER , INTENT(in) :: & |
|---|
| 236 | nlev, nvar ! number of sediment levels |
|---|
| 237 | |
|---|
| 238 | REAL(wp), DIMENSION(jpoce,nlev,nvar), INTENT(inout) :: & |
|---|
| 239 | psol, preac |
|---|
| 240 | |
|---|
| 241 | REAL(wp), INTENT(in) :: dtsed_in |
|---|
| 242 | |
|---|
| 243 | !---Local declarations |
|---|
| 244 | INTEGER :: & |
|---|
| 245 | ji, jk, jn |
|---|
| 246 | |
|---|
| 247 | REAL(wp) :: & |
|---|
| 248 | aplus,aminus , & |
|---|
| 249 | rplus,rminus , & |
|---|
| 250 | dxplus,dxminus |
|---|
| 251 | |
|---|
| 252 | REAL(wp), DIMENSION(nlev) :: za, zb, zc |
|---|
| 253 | REAL(wp), DIMENSION(jpoce,nlev) :: zr |
|---|
| 254 | REAL(wp), DIMENSION(nmax) :: zgamm |
|---|
| 255 | REAL(wp) :: zbet |
|---|
| 256 | |
|---|
| 257 | !---------------------------------------------------------------------- |
|---|
| 258 | |
|---|
| 259 | ! Computation left hand side of linear system of |
|---|
| 260 | ! equations for dissolution reaction |
|---|
| 261 | !--------------------------------------------- |
|---|
| 262 | |
|---|
| 263 | |
|---|
| 264 | IF( ln_timing ) CALL timing_start('sed_mat_btb') |
|---|
| 265 | |
|---|
| 266 | ! first sediment level |
|---|
| 267 | DO ji = 1, jpoce |
|---|
| 268 | aplus = ( por1(2) + por1(3) ) / 2.0 |
|---|
| 269 | dxplus = ( dz(2) + dz(3) ) / 2. |
|---|
| 270 | rplus = ( dtsed_in / vols(2) ) * db(ji,2) * aplus / dxplus |
|---|
| 271 | |
|---|
| 272 | za(1) = 0. |
|---|
| 273 | zb(1) = 1. + rplus |
|---|
| 274 | zc(1) = -rplus |
|---|
| 275 | |
|---|
| 276 | DO jk = 2, nlev - 1 |
|---|
| 277 | aminus = ( por1(jk) + por1(jk+1) ) * 0.5 |
|---|
| 278 | aminus = ( ( vols(jk) / dz(jk) ) + ( vols(jk+1) / dz(jk+1) ) ) / 2. |
|---|
| 279 | dxminus = ( dz(jk) + dz(jk+1) ) / 2. |
|---|
| 280 | rminus = ( dtsed_in / vols(jk+1) ) * db(ji,jk) * aminus / dxminus |
|---|
| 281 | ! |
|---|
| 282 | aplus = ( por1(jk+1) + por1(jk+2) ) * 0.5 |
|---|
| 283 | dxplus = ( dz(jk+1) + dz(jk+2) ) / 2. |
|---|
| 284 | rplus = ( dtsed_in / vols(jk+1) ) * db(ji,jk+1) * aplus / dxplus |
|---|
| 285 | ! |
|---|
| 286 | za(jk) = -rminus |
|---|
| 287 | zb(jk) = 1. + rminus + rplus |
|---|
| 288 | zc(jk) = -rplus |
|---|
| 289 | |
|---|
| 290 | ENDDO |
|---|
| 291 | |
|---|
| 292 | aminus = ( por1(nlev) + por1(nlev+1) ) * 0.5 |
|---|
| 293 | dxminus = ( dz(nlev) + dz(nlev+1) ) / 2. |
|---|
| 294 | rminus = ( dtsed_in / vols(nlev+1) ) * db(ji,nlev) * aminus / dxminus |
|---|
| 295 | ! |
|---|
| 296 | za(nlev) = -rminus |
|---|
| 297 | zb(nlev) = 1. + rminus |
|---|
| 298 | zc(nlev) = 0. |
|---|
| 299 | |
|---|
| 300 | ! solves tridiagonal system of linear equations |
|---|
| 301 | ! ----------------------------------------------- |
|---|
| 302 | DO jn = 1, nvar |
|---|
| 303 | DO jk = 1, nlev |
|---|
| 304 | zr(ji,jk) = psol(ji,jk,jn) |
|---|
| 305 | END DO |
|---|
| 306 | zbet = zb(1) - preac(ji,1,jn) * dtsed_in |
|---|
| 307 | psol(ji,1,jn) = zr(ji,1) / zbet |
|---|
| 308 | ! |
|---|
| 309 | DO jk = 2, nlev |
|---|
| 310 | zgamm(jk) = zc(jk-1) / zbet |
|---|
| 311 | zbet = zb(jk) - preac(ji,jk,jn) * dtsed_in - za(jk) * zgamm(jk) |
|---|
| 312 | psol(ji,jk,jn) = ( zr(ji,jk) - za(jk) * psol(ji,jk-1,jn) ) / zbet |
|---|
| 313 | ENDDO |
|---|
| 314 | ! |
|---|
| 315 | DO jk = nlev - 1, 1, -1 |
|---|
| 316 | psol(ji,jk,jn) = psol(ji,jk,jn) - zgamm(jk+1) * psol(ji,jk+1,jn) |
|---|
| 317 | ENDDO |
|---|
| 318 | END DO |
|---|
| 319 | END DO |
|---|
| 320 | ! |
|---|
| 321 | IF( ln_timing ) CALL timing_stop('sed_mat_btb') |
|---|
| 322 | |
|---|
| 323 | |
|---|
| 324 | END SUBROUTINE sed_mat_btb |
|---|
| 325 | |
|---|
| 326 | SUBROUTINE sed_mat_dsri( nvar, preac, psms, dtsed_in ) |
|---|
| 327 | !!--------------------------------------------------------------------- |
|---|
| 328 | !! *** ROUTINE sed_mat_dsr *** |
|---|
| 329 | !! |
|---|
| 330 | !! ** Purpose : solves tridiagonal system of linear equations |
|---|
| 331 | !! |
|---|
| 332 | !! ** Method : |
|---|
| 333 | !! 1 - computes left hand side of linear system of equations |
|---|
| 334 | !! for dissolution reaction |
|---|
| 335 | !! For mass balance in kbot+sediment : |
|---|
| 336 | !! dz3d (:,1) = dz(1) = 0.5 cm |
|---|
| 337 | !! volw3d(:,1) = dzkbot ( see sedini.F90 ) |
|---|
| 338 | !! dz(2) = 0.3 cm |
|---|
| 339 | !! dz3d(:,2) = 0.3 + dzdep ( see seddsr.F90 ) |
|---|
| 340 | !! volw3d(:,2) and vols3d(l,2) are thickened ( see |
|---|
| 341 | !seddsr.F90 ) |
|---|
| 342 | !! |
|---|
| 343 | !! 2 - forward/backward substitution. |
|---|
| 344 | !! |
|---|
| 345 | !! History : |
|---|
| 346 | !! ! 04-10 (N. Emprin, M. Gehlen ) original |
|---|
| 347 | !! ! 06-04 (C. Ethe) Module Re-organization |
|---|
| 348 | !!---------------------------------------------------------------------- |
|---|
| 349 | !! * Arguments |
|---|
| 350 | INTEGER , INTENT(in) :: nvar ! number of variable |
|---|
| 351 | |
|---|
| 352 | REAL(wp), DIMENSION(jpoce,jpksed), INTENT(in ) :: preac ! reaction rates |
|---|
| 353 | REAL(wp), DIMENSION(jpoce,jpksed), INTENT(in ) :: psms ! reaction rates |
|---|
| 354 | REAL(wp), INTENT(in) :: dtsed_in |
|---|
| 355 | |
|---|
| 356 | !---Local declarations |
|---|
| 357 | INTEGER :: ji, jk, jn |
|---|
| 358 | REAL(wp), DIMENSION(jpoce,jpksed) :: za, zb, zc, zr |
|---|
| 359 | REAL(wp), DIMENSION(jpoce) :: zbet |
|---|
| 360 | REAL(wp), DIMENSION(jpoce,nmax) :: zgamm |
|---|
| 361 | |
|---|
| 362 | REAL(wp) :: aplus,aminus |
|---|
| 363 | REAL(wp) :: rplus,rminus |
|---|
| 364 | REAL(wp) :: dxplus,dxminus |
|---|
| 365 | |
|---|
| 366 | !---------------------------------------------------------------------- |
|---|
| 367 | |
|---|
| 368 | IF( ln_timing ) CALL timing_start('sed_mat_dsri') |
|---|
| 369 | |
|---|
| 370 | ! Computation left hand side of linear system of |
|---|
| 371 | ! equations for dissolution reaction |
|---|
| 372 | !--------------------------------------------- |
|---|
| 373 | |
|---|
| 374 | |
|---|
| 375 | jn = nvar |
|---|
| 376 | ! first sediment level |
|---|
| 377 | DO ji = 1, jpoce |
|---|
| 378 | aplus = ( por(1) + por(2) ) * 0.5 |
|---|
| 379 | dxplus = ( dz3d(ji,1) + dz3d(ji,2) ) / 2. |
|---|
| 380 | rplus = ( dtsed_in / ( volw3d(ji,1) ) ) * diff(ji,1,jn) * aplus / dxplus |
|---|
| 381 | |
|---|
| 382 | za(ji,1) = 0. |
|---|
| 383 | zb(ji,1) = 1. + rplus |
|---|
| 384 | zc(ji,1) = -rplus |
|---|
| 385 | ENDDO |
|---|
| 386 | |
|---|
| 387 | DO jk = 2, jpksed - 1 |
|---|
| 388 | DO ji = 1, jpoce |
|---|
| 389 | aminus = ( por(jk-1) + por(jk) ) * 0.5 |
|---|
| 390 | dxminus = ( dz3d(ji,jk-1) + dz3d(ji,jk) ) / 2. |
|---|
| 391 | |
|---|
| 392 | aplus = ( por(jk+1) + por(jk) ) * 0.5 |
|---|
| 393 | dxplus = ( dz3d(ji,jk) + dz3d(ji,jk+1) ) / 2 |
|---|
| 394 | ! |
|---|
| 395 | rminus = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk-1,jn) * aminus / dxminus |
|---|
| 396 | rplus = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk,jn) * aplus /dxplus |
|---|
| 397 | ! |
|---|
| 398 | za(ji,jk) = -rminus |
|---|
| 399 | zb(ji,jk) = 1. + rminus + rplus |
|---|
| 400 | zc(ji,jk) = -rplus |
|---|
| 401 | END DO |
|---|
| 402 | END DO |
|---|
| 403 | |
|---|
| 404 | DO ji = 1, jpoce |
|---|
| 405 | aminus = ( por(jpksed-1) + por(jpksed) ) *0.5 |
|---|
| 406 | dxminus = ( dz3d(ji,jpksed-1) + dz3d(ji,jpksed) ) / 2. |
|---|
| 407 | rminus = ( dtsed_in / volw3d(ji,jpksed) ) * diff(ji,jpksed-1,jn) * aminus/ dxminus |
|---|
| 408 | ! |
|---|
| 409 | za(ji,jpksed) = -rminus |
|---|
| 410 | zb(ji,jpksed) = 1. + rminus |
|---|
| 411 | zc(ji,jpksed) = 0. |
|---|
| 412 | END DO |
|---|
| 413 | |
|---|
| 414 | |
|---|
| 415 | ! solves tridiagonal system of linear equations |
|---|
| 416 | ! ----------------------------------------------- |
|---|
| 417 | |
|---|
| 418 | zr (:,:) = pwcp(:,:,jn) + psms(:,:) |
|---|
| 419 | zb (:,:) = zb(:,:) - preac(:,:) |
|---|
| 420 | zbet(: ) = zb(:,1) |
|---|
| 421 | pwcp(:,1,jn) = zr(:,1) / zbet(:) |
|---|
| 422 | |
|---|
| 423 | ! |
|---|
| 424 | DO jk = 2, jpksed |
|---|
| 425 | DO ji = 1, jpoce |
|---|
| 426 | zgamm(ji,jk) = zc(ji,jk-1) / zbet(ji) |
|---|
| 427 | zbet(ji) = zb(ji,jk) - za(ji,jk) * zgamm(ji,jk) |
|---|
| 428 | pwcp(ji,jk,jn) = ( zr(ji,jk) - za(ji,jk) * pwcp(ji,jk-1,jn) ) / zbet(ji) |
|---|
| 429 | END DO |
|---|
| 430 | ENDDO |
|---|
| 431 | ! |
|---|
| 432 | DO jk = jpksed - 1, 1, -1 |
|---|
| 433 | DO ji = 1, jpoce |
|---|
| 434 | pwcp(ji,jk,jn) = pwcp(ji,jk,jn) - zgamm(ji,jk+1) * pwcp(ji,jk+1,jn) |
|---|
| 435 | END DO |
|---|
| 436 | ENDDO |
|---|
| 437 | |
|---|
| 438 | IF( ln_timing ) CALL timing_stop('sed_mat_dsri') |
|---|
| 439 | |
|---|
| 440 | |
|---|
| 441 | END SUBROUTINE sed_mat_dsri |
|---|
| 442 | |
|---|
| 443 | |
|---|
| 444 | END MODULE sedmat |
|---|
