Changeset 4488 for palm/trunk/SOURCE/advec_s_up.f90
- Timestamp:
- Apr 3, 2020 11:34:29 AM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/advec_s_up.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_s_up.f90
r4360 r4488 1 1 !> @file advec_s_up.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. 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. 9 8 ! 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 FOR12 ! A PARTICULAR PURPOSE. See the GNU GeneralPublic License for more details.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. 13 12 ! 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/>.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 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4360 2020-01-07 11:25:50Z suehring 27 29 ! Corrected "Former revisions" section 28 ! 30 ! 29 31 ! 3927 2019-04-23 13:24:29Z raasch 30 32 ! pointer attribute removed from scalar 3d-array for performance reasons 31 ! 33 ! 32 34 ! 3665 2019-01-10 08:28:24Z raasch 33 35 ! unused variables removed 34 ! 36 ! 35 37 ! 3655 2019-01-07 16:51:22Z knoop 36 38 ! nopointer option removed … … 45 47 !> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0! 46 48 !> The same problem occurs for all topography boundaries! 47 !------------------------------------------------------------------------------ !49 !--------------------------------------------------------------------------------------------------! 48 50 MODULE advec_s_up_mod 49 51 50 52 51 53 PRIVATE … … 60 62 61 63 62 !------------------------------------------------------------------------------ !64 !--------------------------------------------------------------------------------------------------! 63 65 ! Description: 64 66 ! ------------ 65 67 !> Call for all grid points 66 !------------------------------------------------------------------------------ !67 68 !--------------------------------------------------------------------------------------------------! 69 SUBROUTINE advec_s_up( sk ) 68 70 69 USE arrays_3d,&70 71 USE arrays_3d, & 72 ONLY: ddzu, tend, u, v, w 71 73 72 USE control_parameters,&73 74 USE control_parameters, & 75 ONLY: u_gtrans, v_gtrans 74 76 75 USE grid_variables,&76 77 USE grid_variables, & 78 ONLY: ddx, ddy 77 79 78 USE indices,&79 80 USE indices, & 81 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 80 82 81 83 USE kinds 82 84 83 85 84 86 IMPLICIT NONE 85 87 86 87 88 88 INTEGER(iwp) :: i !< grid index along x-direction 89 INTEGER(iwp) :: j !< grid index along y-direction 90 INTEGER(iwp) :: k !< grid index along z-direction 89 91 90 REAL(wp) :: ukomp !< advection velocity along x-direction91 REAL(wp) :: vkomp !< advection velocity along y-direction92 REAL(wp) :: wkomp !< advection velocity along z-direction92 REAL(wp) :: ukomp !< advection velocity along x-direction 93 REAL(wp) :: vkomp !< advection velocity along y-direction 94 REAL(wp) :: wkomp !< advection velocity along z-direction 93 95 94 96 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !< treated scalar 95 97 96 98 97 98 99 99 DO i = nxl, nxr 100 DO j = nys, nyn 101 DO k = nzb+1, nzt 100 102 ! 101 !-- x-direction 102 ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans 103 IF ( ukomp > 0.0_wp ) THEN 104 tend(k,j,i) = tend(k,j,i) - ukomp * & 105 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 106 ELSE 107 tend(k,j,i) = tend(k,j,i) - ukomp * & 108 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 109 ENDIF 103 !-- x-direction 104 ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans 105 IF ( ukomp > 0.0_wp ) THEN 106 tend(k,j,i) = tend(k,j,i) - ukomp * ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 107 ELSE 108 tend(k,j,i) = tend(k,j,i) - ukomp * ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 109 ENDIF 110 110 ! 111 !-- y-direction 112 vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans 113 IF ( vkomp > 0.0_wp ) THEN 114 tend(k,j,i) = tend(k,j,i) - vkomp * & 115 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 116 ELSE 117 tend(k,j,i) = tend(k,j,i) - vkomp * & 118 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 119 ENDIF 111 !-- y-direction 112 vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans 113 IF ( vkomp > 0.0_wp ) THEN 114 tend(k,j,i) = tend(k,j,i) - vkomp * ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 115 ELSE 116 tend(k,j,i) = tend(k,j,i) - vkomp * ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 117 ENDIF 120 118 ! 121 !-- z-direction 122 wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) ) 123 IF ( wkomp > 0.0_wp ) THEN 124 tend(k,j,i) = tend(k,j,i) - wkomp * & 125 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 126 ELSE 127 tend(k,j,i) = tend(k,j,i) - wkomp * & 128 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) 129 ENDIF 119 !-- z-direction 120 wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) ) 121 IF ( wkomp > 0.0_wp ) THEN 122 tend(k,j,i) = tend(k,j,i) - wkomp * ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 123 ELSE 124 tend(k,j,i) = tend(k,j,i) - wkomp * ( sk(k+1,j,i) - sk(k,j,i) ) * ddzu(k+1) 125 ENDIF 130 126 131 ENDDO132 127 ENDDO 133 128 ENDDO 129 ENDDO 134 130 135 131 END SUBROUTINE advec_s_up 136 132 137 133 138 !------------------------------------------------------------------------------ !134 !--------------------------------------------------------------------------------------------------! 139 135 ! Description: 140 136 ! ------------ 141 137 !> Call for grid point i,j 142 !------------------------------------------------------------------------------ !143 138 !--------------------------------------------------------------------------------------------------! 139 SUBROUTINE advec_s_up_ij( i, j, sk ) 144 140 145 USE arrays_3d,&146 141 USE arrays_3d, & 142 ONLY: ddzu, tend, u, v, w 147 143 148 USE control_parameters,&149 144 USE control_parameters, & 145 ONLY: u_gtrans, v_gtrans 150 146 151 USE grid_variables,&152 147 USE grid_variables, & 148 ONLY: ddx, ddy 153 149 154 USE indices,&155 150 USE indices, & 151 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt 156 152 157 153 USE kinds 158 154 159 155 160 156 IMPLICIT NONE 161 157 162 163 164 158 INTEGER(iwp) :: i !< grid index along x-direction 159 INTEGER(iwp) :: j !< grid index along y-direction 160 INTEGER(iwp) :: k !< grid index along z-direction 165 161 166 REAL(wp) :: ukomp !< advection velocity along x-direction167 REAL(wp) :: vkomp !< advection velocity along y-direction168 REAL(wp) :: wkomp !< advection velocity along z-direction169 170 162 REAL(wp) :: ukomp !< advection velocity along x-direction 163 REAL(wp) :: vkomp !< advection velocity along y-direction 164 REAL(wp) :: wkomp !< advection velocity along z-direction 165 166 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !< treated scalar 171 167 172 168 173 169 DO k = nzb+1, nzt 174 170 ! 175 !-- x-direction 176 ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans 177 IF ( ukomp > 0.0_wp ) THEN 178 tend(k,j,i) = tend(k,j,i) - ukomp * & 179 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 180 ELSE 181 tend(k,j,i) = tend(k,j,i) - ukomp * & 182 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 183 ENDIF 171 !-- x-direction 172 ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans 173 IF ( ukomp > 0.0_wp ) THEN 174 tend(k,j,i) = tend(k,j,i) - ukomp * ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 175 ELSE 176 tend(k,j,i) = tend(k,j,i) - ukomp * ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 177 ENDIF 184 178 ! 185 !-- y-direction 186 vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans 187 IF ( vkomp > 0.0_wp ) THEN 188 tend(k,j,i) = tend(k,j,i) - vkomp * & 189 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 190 ELSE 191 tend(k,j,i) = tend(k,j,i) - vkomp * & 192 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 193 ENDIF 179 !-- y-direction 180 vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans 181 IF ( vkomp > 0.0_wp ) THEN 182 tend(k,j,i) = tend(k,j,i) - vkomp * ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 183 ELSE 184 tend(k,j,i) = tend(k,j,i) - vkomp * ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 185 ENDIF 194 186 ! 195 !-- z-direction 196 wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) ) 197 IF ( wkomp > 0.0_wp ) THEN 198 tend(k,j,i) = tend(k,j,i) - wkomp * & 199 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 200 ELSE 201 tend(k,j,i) = tend(k,j,i) - wkomp * & 202 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) 203 ENDIF 187 !-- z-direction 188 wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) ) 189 IF ( wkomp > 0.0_wp ) THEN 190 tend(k,j,i) = tend(k,j,i) - wkomp * ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 191 ELSE 192 tend(k,j,i) = tend(k,j,i) - wkomp * ( sk(k+1,j,i) - sk(k,j,i) ) * ddzu(k+1) 193 ENDIF 204 194 205 195 ENDDO 206 196 207 197 END SUBROUTINE advec_s_up_ij 208 198 209 199 END MODULE advec_s_up_mod
Note: See TracChangeset
for help on using the changeset viewer.
