Changeset 4591 for palm/trunk/SOURCE/sor.f90
- Timestamp:
- Jul 6, 2020 3:56:08 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/sor.f90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/sor.f90
r4457 r4591 1 1 !> @file sor.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------! 17 !--------------------------------------------------------------------------------------------------! 18 ! 19 19 ! 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! use statement for exchange horiz added 28 ! 27 ! File re-formatted to follow the PALM coding standard 28 ! 29 ! 30 ! 4457 2020-03-11 14:20:43Z raasch 31 ! Use statement for exchange horiz added 32 ! 29 33 ! 4360 2020-01-07 11:25:50Z suehring 30 34 ! Corrected "Former revisions" section 31 ! 35 ! 32 36 ! 3655 2019-01-07 16:51:22Z knoop 33 37 ! Rename variables in mesoscale-offline nesting mode … … 36 40 ! Initial revision 37 41 ! 38 ! 42 !--------------------------------------------------------------------------------------------------! 39 43 ! Description: 40 44 ! ------------ 41 45 !> Solve the Poisson-equation with the SOR-Red/Black-scheme. 42 !------------------------------------------------------------------------------ !46 !--------------------------------------------------------------------------------------------------! 43 47 SUBROUTINE sor( d, ddzu, ddzw, p ) 44 48 45 USE arrays_3d, & 46 ONLY: rho_air, rho_air_zw 47 48 USE control_parameters, & 49 ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, & 50 bc_dirichlet_s, bc_lr_cyc, bc_ns_cyc, bc_radiation_l, & 51 bc_radiation_n, bc_radiation_r, bc_radiation_s, ibc_p_b, & 52 ibc_p_t, n_sor, omega_sor 53 54 USE exchange_horiz_mod, & 49 USE arrays_3d, & 50 ONLY: rho_air, & 51 rho_air_zw 52 53 USE control_parameters, & 54 ONLY: bc_dirichlet_l, & 55 bc_dirichlet_n, & 56 bc_dirichlet_r, & 57 bc_dirichlet_s, & 58 bc_lr_cyc, & 59 bc_ns_cyc, & 60 bc_radiation_l, & 61 bc_radiation_n, & 62 bc_radiation_r, & 63 bc_radiation_s, & 64 ibc_p_b, & 65 ibc_p_t, & 66 n_sor, & 67 omega_sor 68 69 USE exchange_horiz_mod, & 55 70 ONLY: exchange_horiz 56 71 57 USE grid_variables, & 58 ONLY: ddx2, ddy2 59 60 USE indices, & 61 ONLY: nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nz, nzb, nzt 72 USE grid_variables, & 73 ONLY: ddx2, & 74 ddy2 75 76 USE indices, & 77 ONLY: nbgp, & 78 nxl, & 79 nxlg, & 80 nxr, & 81 nxrg, & 82 nyn, & 83 nyng, & 84 nys, & 85 nysg, & 86 nz, & 87 nzb, & 88 nzt 62 89 63 90 USE kinds … … 65 92 IMPLICIT NONE 66 93 67 INTEGER(iwp) :: i 68 INTEGER(iwp) :: j 69 INTEGER(iwp) :: k 70 INTEGER(iwp) :: n 71 INTEGER(iwp) :: nxl1 72 INTEGER(iwp) :: nxl2 73 INTEGER(iwp) :: nys1 74 INTEGER(iwp) :: nys2 75 76 REAL(wp) 77 REAL(wp) 78 79 REAL(wp) 80 REAL(wp) 81 82 REAL(wp), DIMENSION(:), ALLOCATABLE :: f1 83 REAL(wp), DIMENSION(:), ALLOCATABLE :: f2 84 REAL(wp), DIMENSION(:), ALLOCATABLE :: f3 94 INTEGER(iwp) :: i !< 95 INTEGER(iwp) :: j !< 96 INTEGER(iwp) :: k !< 97 INTEGER(iwp) :: n !< 98 INTEGER(iwp) :: nxl1 !< 99 INTEGER(iwp) :: nxl2 !< 100 INTEGER(iwp) :: nys1 !< 101 INTEGER(iwp) :: nys2 !< 102 103 REAL(wp) :: ddzu(1:nz+1) !< 104 REAL(wp) :: ddzw(1:nzt+1) !< 105 106 REAL(wp) :: d(nzb+1:nzt,nys:nyn,nxl:nxr) !< 107 REAL(wp) :: p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) !< 108 109 REAL(wp), DIMENSION(:), ALLOCATABLE :: f1 !< 110 REAL(wp), DIMENSION(:), ALLOCATABLE :: f2 !< 111 REAL(wp), DIMENSION(:), ALLOCATABLE :: f3 !< 85 112 86 113 ALLOCATE( f1(1:nz), f2(1:nz), f3(1:nz) ) … … 118 145 DO j = nys2, nyn, 2 119 146 DO k = nzb+1, nzt 120 p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( &121 rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + &122 rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + &123 f2(k) * p(k+1,j,i) + &124 f3(k) * p(k-1,j,i) - &125 d(k,j,i) - &126 f1(k) * p(k,j,i) )147 p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( & 148 rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + & 149 rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + & 150 f2(k) * p(k+1,j,i) + & 151 f3(k) * p(k-1,j,i) - & 152 d(k,j,i) - & 153 f1(k) * p(k,j,i) ) 127 154 ENDDO 128 155 ENDDO … … 132 159 DO j = nys1, nyn, 2 133 160 DO k = nzb+1, nzt 134 p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( &135 rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + &136 rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + &137 f2(k) * p(k+1,j,i) + &138 f3(k) * p(k-1,j,i) - &139 d(k,j,i) - &140 f1(k) * p(k,j,i) )161 p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( & 162 rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + & 163 rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + & 164 f2(k) * p(k+1,j,i) + & 165 f3(k) * p(k-1,j,i) - & 166 d(k,j,i) - & 167 f1(k) * p(k,j,i) ) 141 168 ENDDO 142 169 ENDDO … … 146 173 !-- Exchange of boundary values for p. 147 174 CALL exchange_horiz( p, nbgp ) 175 148 176 149 177 ! … … 163 191 DO j = nys1, nyn, 2 164 192 DO k = nzb+1, nzt 165 p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( &166 rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + &167 rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + &168 f2(k) * p(k+1,j,i) + &169 f3(k) * p(k-1,j,i) - &170 d(k,j,i) - &171 f1(k) * p(k,j,i) )193 p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( & 194 rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + & 195 rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + & 196 f2(k) * p(k+1,j,i) + & 197 f3(k) * p(k-1,j,i) - & 198 d(k,j,i) - & 199 f1(k) * p(k,j,i) ) 172 200 ENDDO 173 201 ENDDO … … 177 205 DO j = nys2, nyn, 2 178 206 DO k = nzb+1, nzt 179 p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( &180 rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + &181 rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + &182 f2(k) * p(k+1,j,i) + &183 f3(k) * p(k-1,j,i) - &184 d(k,j,i) - &185 f1(k) * p(k,j,i) )207 p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( & 208 rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + & 209 rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + & 210 f2(k) * p(k+1,j,i) + & 211 f3(k) * p(k-1,j,i) - & 212 d(k,j,i) - & 213 f1(k) * p(k,j,i) ) 186 214 ENDDO 187 215 ENDDO … … 195 223 !-- Boundary conditions top/bottom. 196 224 !-- Bottom boundary 197 IF ( ibc_p_b == 1 ) THEN ! 225 IF ( ibc_p_b == 1 ) THEN ! Neumann 198 226 p(nzb,:,:) = p(nzb+1,:,:) 199 ELSE ! 227 ELSE ! Dirichlet 200 228 p(nzb,:,:) = 0.0_wp 201 229 ENDIF … … 203 231 ! 204 232 !-- Top boundary 205 IF ( ibc_p_t == 1 ) THEN !Neumann233 IF ( ibc_p_t == 1 ) THEN ! Neumann 206 234 p(nzt+1,:,:) = p(nzt,:,:) 207 ELSE !Dirichlet235 ELSE ! Dirichlet 208 236 p(nzt+1,:,:) = 0.0_wp 209 237 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
