Changeset 3538 for palm/trunk/SOURCE
- Timestamp:
- Nov 20, 2018 10:55:41 AM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 11 edited
-
advec_s_pw.f90 (modified) (5 diffs)
-
advec_s_up.f90 (modified) (9 diffs)
-
advec_u_pw.f90 (modified) (5 diffs)
-
advec_u_up.f90 (modified) (9 diffs)
-
advec_v_pw.f90 (modified) (5 diffs)
-
advec_v_up.f90 (modified) (9 diffs)
-
advec_w_pw.f90 (modified) (5 diffs)
-
advec_w_up.f90 (modified) (9 diffs)
-
buoyancy.f90 (modified) (9 diffs)
-
coriolis.f90 (modified) (2 diffs)
-
init_grid.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_s_pw.f90
r3302 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove unnecessary double-masking of topography 28 ! 29 ! 3302 2018-10-03 02:39:40Z raasch 27 30 ! Stokes drift velocity added 28 31 ! … … 116 119 117 120 USE indices, & 118 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, & 119 nzt, wall_flags_0 121 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 120 122 121 123 USE kinds … … 163 165 ( sk(k-1,j,i) - sk(k,j,i) ) & 164 166 ) * dd2zu(k) & 165 ) * MERGE( 1.0_wp, 0.0_wp, & 166 BTEST( wall_flags_0(k,j,i), 0 ) ) 167 ) 167 168 ENDDO 168 169 ENDDO … … 189 190 190 191 USE indices, & 191 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt , wall_flags_0192 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt 192 193 193 194 USE kinds … … 233 234 ( sk(k-1,j,i) - sk(k,j,i) ) & 234 235 ) * dd2zu(k) & 235 ) * MERGE( 1.0_wp, 0.0_wp, & 236 BTEST( wall_flags_0(k,j,i), 0 ) ) 236 ) 237 237 ENDDO 238 238 -
palm/trunk/SOURCE/advec_s_up.f90
r2718 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove unnecessary double-masking of topography 28 ! 29 ! 2718 2018-01-02 08:49:38Z maronga 27 30 ! Corrected "Former revisions" section 28 31 ! … … 113 116 114 117 USE indices, & 115 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 116 wall_flags_0 118 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 117 119 118 120 USE kinds … … 143 145 IF ( ukomp > 0.0_wp ) THEN 144 146 tend(k,j,i) = tend(k,j,i) - ukomp * & 145 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx & 146 * MERGE( 1.0_wp, 0.0_wp, & 147 BTEST( wall_flags_0(k,j,i), 0 ) ) 147 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 148 148 ELSE 149 149 tend(k,j,i) = tend(k,j,i) - ukomp * & 150 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx & 151 * MERGE( 1.0_wp, 0.0_wp, & 152 BTEST( wall_flags_0(k,j,i), 0 ) ) 150 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 153 151 ENDIF 154 152 ! … … 157 155 IF ( vkomp > 0.0_wp ) THEN 158 156 tend(k,j,i) = tend(k,j,i) - vkomp * & 159 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy & 160 * MERGE( 1.0_wp, 0.0_wp, & 161 BTEST( wall_flags_0(k,j,i), 0 ) ) 157 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 162 158 ELSE 163 159 tend(k,j,i) = tend(k,j,i) - vkomp * & 164 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy & 165 * MERGE( 1.0_wp, 0.0_wp, & 166 BTEST( wall_flags_0(k,j,i), 0 ) ) 160 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 167 161 ENDIF 168 162 ! … … 171 165 IF ( wkomp > 0.0_wp ) THEN 172 166 tend(k,j,i) = tend(k,j,i) - wkomp * & 173 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) & 174 * MERGE( 1.0_wp, 0.0_wp, & 175 BTEST( wall_flags_0(k,j,i), 0 ) ) 167 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 176 168 ELSE 177 169 tend(k,j,i) = tend(k,j,i) - wkomp * & 178 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) & 179 * MERGE( 1.0_wp, 0.0_wp, & 180 BTEST( wall_flags_0(k,j,i), 0 ) ) 170 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) 181 171 ENDIF 182 172 … … 205 195 206 196 USE indices, & 207 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt , wall_flags_0197 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt 208 198 209 199 USE kinds … … 233 223 IF ( ukomp > 0.0_wp ) THEN 234 224 tend(k,j,i) = tend(k,j,i) - ukomp * & 235 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx & 236 * MERGE( 1.0_wp, 0.0_wp, & 237 BTEST( wall_flags_0(k,j,i), 0 ) ) 225 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 238 226 ELSE 239 227 tend(k,j,i) = tend(k,j,i) - ukomp * & 240 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx & 241 * MERGE( 1.0_wp, 0.0_wp, & 242 BTEST( wall_flags_0(k,j,i), 0 ) ) 228 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 243 229 ENDIF 244 230 ! … … 247 233 IF ( vkomp > 0.0_wp ) THEN 248 234 tend(k,j,i) = tend(k,j,i) - vkomp * & 249 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy & 250 * MERGE( 1.0_wp, 0.0_wp, & 251 BTEST( wall_flags_0(k,j,i), 0 ) ) 235 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 252 236 ELSE 253 237 tend(k,j,i) = tend(k,j,i) - vkomp * & 254 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy & 255 * MERGE( 1.0_wp, 0.0_wp, & 256 BTEST( wall_flags_0(k,j,i), 0 ) ) 238 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 257 239 ENDIF 258 240 ! … … 261 243 IF ( wkomp > 0.0_wp ) THEN 262 244 tend(k,j,i) = tend(k,j,i) - wkomp * & 263 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) & 264 * MERGE( 1.0_wp, 0.0_wp, & 265 BTEST( wall_flags_0(k,j,i), 0 ) ) 245 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 266 246 ELSE 267 247 tend(k,j,i) = tend(k,j,i) - wkomp * & 268 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) & 269 * MERGE( 1.0_wp, 0.0_wp, & 270 BTEST( wall_flags_0(k,j,i), 0 ) ) 248 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) 271 249 ENDIF 272 250 -
palm/trunk/SOURCE/advec_u_pw.f90
r2718 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove unnecessary double-masking of topography 28 ! 29 ! 2718 2018-01-02 08:49:38Z maronga 27 30 ! Corrected "Former revisions" section 28 31 ! … … 105 108 106 109 USE indices, & 107 ONLY: nxlu, nxr, nyn, nys, nzb, nzt , wall_flags_0110 ONLY: nxlu, nxr, nyn, nys, nzb, nzt 108 111 109 112 USE kinds … … 132 135 - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) ) & 133 136 * ddzw(k) & 134 ) & 135 * MERGE( 1.0_wp, 0.0_wp, & 136 BTEST( wall_flags_0(k,j,i), 1 ) ) 137 ) 137 138 ENDDO 138 139 ENDDO … … 159 160 160 161 USE indices, & 161 ONLY: nzb, nzt , wall_flags_0162 ONLY: nzb, nzt 162 163 163 164 USE kinds … … 184 185 - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) ) & 185 186 * ddzw(k) & 186 ) & 187 * MERGE( 1.0_wp, 0.0_wp, & 188 BTEST( wall_flags_0(k,j,i), 1 ) ) 187 ) 189 188 ENDDO 190 189 -
palm/trunk/SOURCE/advec_u_up.f90
r2718 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove unnecessary double-masking of topography 28 ! 29 ! 2718 2018-01-02 08:49:38Z maronga 27 30 ! Corrected "Former revisions" section 28 31 ! … … 104 107 105 108 USE indices, & 106 ONLY: nxlu, nxr, nyn, nys, nzb, nzt , wall_flags_0109 ONLY: nxlu, nxr, nyn, nys, nzb, nzt 107 110 108 111 USE kinds … … 128 131 IF ( ukomp > 0.0_wp ) THEN 129 132 tend(k,j,i) = tend(k,j,i) - ukomp * & 130 ( u(k,j,i) - u(k,j,i-1) ) * ddx & 131 * MERGE( 1.0_wp, 0.0_wp, & 132 BTEST( wall_flags_0(k,j,i), 1 ) ) 133 ( u(k,j,i) - u(k,j,i-1) ) * ddx 133 134 ELSE 134 135 tend(k,j,i) = tend(k,j,i) - ukomp * & 135 ( u(k,j,i+1) - u(k,j,i) ) * ddx & 136 * MERGE( 1.0_wp, 0.0_wp, & 137 BTEST( wall_flags_0(k,j,i), 1 ) ) 136 ( u(k,j,i+1) - u(k,j,i) ) * ddx 138 137 ENDIF 139 138 ! … … 143 142 IF ( vkomp > 0.0_wp ) THEN 144 143 tend(k,j,i) = tend(k,j,i) - vkomp * & 145 ( u(k,j,i) - u(k,j-1,i) ) * ddy & 146 * MERGE( 1.0_wp, 0.0_wp, & 147 BTEST( wall_flags_0(k,j,i), 1 ) ) 144 ( u(k,j,i) - u(k,j-1,i) ) * ddy 148 145 ELSE 149 146 tend(k,j,i) = tend(k,j,i) - vkomp * & 150 ( u(k,j+1,i) - u(k,j,i) ) * ddy & 151 * MERGE( 1.0_wp, 0.0_wp, & 152 BTEST( wall_flags_0(k,j,i), 1 ) ) 147 ( u(k,j+1,i) - u(k,j,i) ) * ddy 153 148 ENDIF 154 149 ! … … 158 153 IF ( wkomp > 0.0_wp ) THEN 159 154 tend(k,j,i) = tend(k,j,i) - wkomp * & 160 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) & 161 * MERGE( 1.0_wp, 0.0_wp, & 162 BTEST( wall_flags_0(k,j,i), 1 ) ) 155 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) 163 156 ELSE 164 157 tend(k,j,i) = tend(k,j,i) - wkomp * & 165 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) & 166 * MERGE( 1.0_wp, 0.0_wp, & 167 BTEST( wall_flags_0(k,j,i), 1 ) ) 158 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) 168 159 ENDIF 169 160 … … 192 183 193 184 USE indices, & 194 ONLY: nzb, nzt , wall_flags_0185 ONLY: nzb, nzt 195 186 196 187 USE kinds … … 214 205 IF ( ukomp > 0.0_wp ) THEN 215 206 tend(k,j,i) = tend(k,j,i) - ukomp * & 216 ( u(k,j,i) - u(k,j,i-1) ) * ddx & 217 * MERGE( 1.0_wp, 0.0_wp, & 218 BTEST( wall_flags_0(k,j,i), 1 ) ) 207 ( u(k,j,i) - u(k,j,i-1) ) * ddx 219 208 ELSE 220 209 tend(k,j,i) = tend(k,j,i) - ukomp * & 221 ( u(k,j,i+1) - u(k,j,i) ) * ddx & 222 * MERGE( 1.0_wp, 0.0_wp, & 223 BTEST( wall_flags_0(k,j,i), 1 ) ) 210 ( u(k,j,i+1) - u(k,j,i) ) * ddx 224 211 ENDIF 225 212 ! … … 229 216 IF ( vkomp > 0.0_wp ) THEN 230 217 tend(k,j,i) = tend(k,j,i) - vkomp * & 231 ( u(k,j,i) - u(k,j-1,i) ) * ddy & 232 * MERGE( 1.0_wp, 0.0_wp, & 233 BTEST( wall_flags_0(k,j,i), 1 ) ) 218 ( u(k,j,i) - u(k,j-1,i) ) * ddy 234 219 ELSE 235 220 tend(k,j,i) = tend(k,j,i) - vkomp * & 236 ( u(k,j+1,i) - u(k,j,i) ) * ddy & 237 * MERGE( 1.0_wp, 0.0_wp, & 238 BTEST( wall_flags_0(k,j,i), 1 ) ) 221 ( u(k,j+1,i) - u(k,j,i) ) * ddy 239 222 ENDIF 240 223 ! … … 243 226 IF ( wkomp > 0.0_wp ) THEN 244 227 tend(k,j,i) = tend(k,j,i) - wkomp * & 245 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) & 246 * MERGE( 1.0_wp, 0.0_wp, & 247 BTEST( wall_flags_0(k,j,i), 1 ) ) 228 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) 248 229 ELSE 249 230 tend(k,j,i) = tend(k,j,i) - wkomp * & 250 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) & 251 * MERGE( 1.0_wp, 0.0_wp, & 252 BTEST( wall_flags_0(k,j,i), 1 ) ) 231 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) 253 232 ENDIF 254 233 -
palm/trunk/SOURCE/advec_v_pw.f90
r2718 r3538 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Remove unnecessary double-masking of topography 29 ! 30 ! 2718 2018-01-02 08:49:38Z maronga 28 31 ! Corrected "Former revisions" section 29 32 ! … … 106 109 107 110 USE indices, & 108 ONLY: nxl, nxr, nyn, nysv, nzb, nzt , wall_flags_0111 ONLY: nxl, nxr, nyn, nysv, nzb, nzt 109 112 110 113 USE kinds … … 134 137 - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) ) & 135 138 * ddzw(k) & 136 ) & 137 * MERGE( 1.0_wp, 0.0_wp, & 138 BTEST( wall_flags_0(k,j,i), 2 ) ) 139 ) 139 140 ENDDO 140 141 ENDDO … … 161 162 162 163 USE indices, & 163 ONLY: nzb, nzt , wall_flags_0164 ONLY: nzb, nzt 164 165 165 166 USE kinds … … 187 188 - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) ) & 188 189 * ddzw(k) & 189 ) & 190 * MERGE( 1.0_wp, 0.0_wp, & 191 BTEST( wall_flags_0(k,j,i), 2 ) ) 190 ) 192 191 ENDDO 193 192 -
palm/trunk/SOURCE/advec_v_up.f90
r2718 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove unnecessary double-masking of topography 28 ! 29 ! 2718 2018-01-02 08:49:38Z maronga 27 30 ! Corrected "Former revisions" section 28 31 ! … … 104 107 105 108 USE indices, & 106 ONLY: nxl, nxr, nyn, nysv, nzb, nzt , wall_flags_0109 ONLY: nxl, nxr, nyn, nysv, nzb, nzt 107 110 108 111 USE kinds … … 129 132 IF ( ukomp > 0.0_wp ) THEN 130 133 tend(k,j,i) = tend(k,j,i) - ukomp * & 131 ( v(k,j,i) - v(k,j,i-1) ) * ddx & 132 * MERGE( 1.0_wp, 0.0_wp, & 133 BTEST( wall_flags_0(k,j,i), 2 ) ) 134 ( v(k,j,i) - v(k,j,i-1) ) * ddx 134 135 ELSE 135 136 tend(k,j,i) = tend(k,j,i) - ukomp * & 136 ( v(k,j,i+1) - v(k,j,i) ) * ddx & 137 * MERGE( 1.0_wp, 0.0_wp, & 138 BTEST( wall_flags_0(k,j,i), 2 ) ) 137 ( v(k,j,i+1) - v(k,j,i) ) * ddx 139 138 ENDIF 140 139 ! … … 143 142 IF ( vkomp > 0.0_wp ) THEN 144 143 tend(k,j,i) = tend(k,j,i) - vkomp * & 145 ( v(k,j,i) - v(k,j-1,i) ) * ddy & 146 * MERGE( 1.0_wp, 0.0_wp, & 147 BTEST( wall_flags_0(k,j,i), 2 ) ) 144 ( v(k,j,i) - v(k,j-1,i) ) * ddy 148 145 ELSE 149 146 tend(k,j,i) = tend(k,j,i) - vkomp * & 150 ( v(k,j+1,i) - v(k,j,i) ) * ddy & 151 * MERGE( 1.0_wp, 0.0_wp, & 152 BTEST( wall_flags_0(k,j,i), 2 ) ) 147 ( v(k,j+1,i) - v(k,j,i) ) * ddy 153 148 ENDIF 154 149 ! … … 158 153 IF ( wkomp > 0.0_wp ) THEN 159 154 tend(k,j,i) = tend(k,j,i) - wkomp * & 160 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) & 161 * MERGE( 1.0_wp, 0.0_wp, & 162 BTEST( wall_flags_0(k,j,i), 2 ) ) 155 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) 163 156 ELSE 164 157 tend(k,j,i) = tend(k,j,i) - wkomp * & 165 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) & 166 * MERGE( 1.0_wp, 0.0_wp, & 167 BTEST( wall_flags_0(k,j,i), 2 ) ) 158 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) 168 159 ENDIF 169 160 … … 192 183 193 184 USE indices, & 194 ONLY: nzb, nzt , wall_flags_0185 ONLY: nzb, nzt 195 186 196 187 USE kinds … … 215 206 IF ( ukomp > 0.0_wp ) THEN 216 207 tend(k,j,i) = tend(k,j,i) - ukomp * & 217 ( v(k,j,i) - v(k,j,i-1) ) * ddx & 218 * MERGE( 1.0_wp, 0.0_wp, & 219 BTEST( wall_flags_0(k,j,i), 2 ) ) 208 ( v(k,j,i) - v(k,j,i-1) ) * ddx 220 209 ELSE 221 210 tend(k,j,i) = tend(k,j,i) - ukomp * & 222 ( v(k,j,i+1) - v(k,j,i) ) * ddx & 223 * MERGE( 1.0_wp, 0.0_wp, & 224 BTEST( wall_flags_0(k,j,i), 2 ) ) 211 ( v(k,j,i+1) - v(k,j,i) ) * ddx 225 212 ENDIF 226 213 ! … … 229 216 IF ( vkomp > 0.0_wp ) THEN 230 217 tend(k,j,i) = tend(k,j,i) - vkomp * & 231 ( v(k,j,i) - v(k,j-1,i) ) * ddy & 232 * MERGE( 1.0_wp, 0.0_wp, & 233 BTEST( wall_flags_0(k,j,i), 2 ) ) 218 ( v(k,j,i) - v(k,j-1,i) ) * ddy 234 219 ELSE 235 220 tend(k,j,i) = tend(k,j,i) - vkomp * & 236 ( v(k,j+1,i) - v(k,j,i) ) * ddy & 237 * MERGE( 1.0_wp, 0.0_wp, & 238 BTEST( wall_flags_0(k,j,i), 2 ) ) 221 ( v(k,j+1,i) - v(k,j,i) ) * ddy 239 222 ENDIF 240 223 ! … … 243 226 IF ( wkomp > 0.0_wp ) THEN 244 227 tend(k,j,i) = tend(k,j,i) - wkomp * & 245 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) & 246 * MERGE( 1.0_wp, 0.0_wp, & 247 BTEST( wall_flags_0(k,j,i), 2 ) ) 228 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) 248 229 ELSE 249 230 tend(k,j,i) = tend(k,j,i) - wkomp * & 250 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) & 251 * MERGE( 1.0_wp, 0.0_wp, & 252 BTEST( wall_flags_0(k,j,i), 2 ) ) 231 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) 253 232 ENDIF 254 233 -
palm/trunk/SOURCE/advec_w_pw.f90
r2718 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove unnecessary double-masking of topography 28 ! 29 ! 2718 2018-01-02 08:49:38Z maronga 27 30 ! Corrected "Former revisions" section 28 31 ! … … 105 108 106 109 USE indices, & 107 ONLY: nxl, nxr, nyn, nys, nzb, nzt , wall_flags_0110 ONLY: nxl, nxr, nyn, nys, nzb, nzt 108 111 109 112 USE kinds … … 133 136 - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) ) & 134 137 * ddzu(k+1) & 135 ) & 136 * MERGE( 1.0_wp, 0.0_wp, & 137 BTEST( wall_flags_0(k,j,i), 3 ) ) 138 ) 138 139 ENDDO 139 140 ENDDO … … 160 161 161 162 USE indices, & 162 ONLY: nzb, nzt , wall_flags_0163 ONLY: nzb, nzt 163 164 164 165 USE kinds … … 185 186 - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) ) & 186 187 * ddzu(k+1) & 187 ) & 188 * MERGE( 1.0_wp, 0.0_wp, & 189 BTEST( wall_flags_0(k,j,i), 3 ) ) 188 ) 190 189 ENDDO 191 190 END SUBROUTINE advec_w_pw_ij -
palm/trunk/SOURCE/advec_w_up.f90
r3255 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove unnecessary double-masking of topography 28 ! 29 ! 3255 2018-09-17 11:57:36Z suehring 27 30 ! Missing wall flags added 28 31 ! … … 107 110 108 111 USE indices, & 109 ONLY: nxl, nxr, nyn, nys, nzb, nzt , wall_flags_0112 ONLY: nxl, nxr, nyn, nys, nzb, nzt 110 113 111 114 USE kinds … … 131 134 IF ( ukomp > 0.0_wp ) THEN 132 135 tend(k,j,i) = tend(k,j,i) - ukomp * & 133 ( w(k,j,i) - w(k,j,i-1) ) * ddx & 134 * MERGE( 1.0_wp, 0.0_wp, & 135 BTEST( wall_flags_0(k,j,i), 3 ) ) 136 ( w(k,j,i) - w(k,j,i-1) ) * ddx 136 137 ELSE 137 138 tend(k,j,i) = tend(k,j,i) - ukomp * & 138 ( w(k,j,i+1) - w(k,j,i) ) * ddx & 139 * MERGE( 1.0_wp, 0.0_wp, & 140 BTEST( wall_flags_0(k,j,i), 3 ) ) 139 ( w(k,j,i+1) - w(k,j,i) ) * ddx 141 140 ENDIF 142 141 ! … … 146 145 IF ( vkomp > 0.0_wp ) THEN 147 146 tend(k,j,i) = tend(k,j,i) - vkomp * & 148 ( w(k,j,i) - w(k,j-1,i) ) * ddy & 149 * MERGE( 1.0_wp, 0.0_wp, & 150 BTEST( wall_flags_0(k,j,i), 3 ) ) 147 ( w(k,j,i) - w(k,j-1,i) ) * ddy 151 148 ELSE 152 149 tend(k,j,i) = tend(k,j,i) - vkomp * & 153 ( w(k,j+1,i) - w(k,j,i) ) * ddy & 154 * MERGE( 1.0_wp, 0.0_wp, & 155 BTEST( wall_flags_0(k,j,i), 3 ) ) 150 ( w(k,j+1,i) - w(k,j,i) ) * ddy 156 151 ENDIF 157 152 ! … … 159 154 IF ( w(k,j,i) > 0.0_wp ) THEN 160 155 tend(k,j,i) = tend(k,j,i) - w(k,j,i) * & 161 ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) & 162 * MERGE( 1.0_wp, 0.0_wp, & 163 BTEST( wall_flags_0(k,j,i), 3 ) ) 156 ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) 164 157 ELSE 165 158 tend(k,j,i) = tend(k,j,i) - w(k,j,i) * & 166 ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) & 167 * MERGE( 1.0_wp, 0.0_wp, & 168 BTEST( wall_flags_0(k,j,i), 3 ) ) 159 ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) 169 160 ENDIF 170 161 … … 193 184 194 185 USE indices, & 195 ONLY: nzb, nzt , wall_flags_0186 ONLY: nzb, nzt 196 187 197 188 USE kinds … … 215 206 IF ( ukomp > 0.0_wp ) THEN 216 207 tend(k,j,i) = tend(k,j,i) - ukomp * & 217 ( w(k,j,i) - w(k,j,i-1) ) * ddx & 218 * MERGE( 1.0_wp, 0.0_wp, & 219 BTEST( wall_flags_0(k,j,i), 3 ) ) 208 ( w(k,j,i) - w(k,j,i-1) ) * ddx 220 209 ELSE 221 210 tend(k,j,i) = tend(k,j,i) - ukomp * & 222 ( w(k,j,i+1) - w(k,j,i) ) * ddx & 223 * MERGE( 1.0_wp, 0.0_wp, & 224 BTEST( wall_flags_0(k,j,i), 3 ) ) 211 ( w(k,j,i+1) - w(k,j,i) ) * ddx 225 212 ENDIF 226 213 ! … … 230 217 IF ( vkomp > 0.0_wp ) THEN 231 218 tend(k,j,i) = tend(k,j,i) - vkomp * & 232 ( w(k,j,i) - w(k,j-1,i) ) * ddy & 233 * MERGE( 1.0_wp, 0.0_wp, & 234 BTEST( wall_flags_0(k,j,i), 3 ) ) 219 ( w(k,j,i) - w(k,j-1,i) ) * ddy 235 220 ELSE 236 221 tend(k,j,i) = tend(k,j,i) - vkomp * & 237 ( w(k,j+1,i) - w(k,j,i) ) * ddy & 238 * MERGE( 1.0_wp, 0.0_wp, & 239 BTEST( wall_flags_0(k,j,i), 3 ) ) 222 ( w(k,j+1,i) - w(k,j,i) ) * ddy 240 223 ENDIF 241 224 ! … … 243 226 IF ( w(k,j,i) > 0.0_wp ) THEN 244 227 tend(k,j,i) = tend(k,j,i) - w(k,j,i) * & 245 ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) & 246 * MERGE( 1.0_wp, 0.0_wp, & 247 BTEST( wall_flags_0(k,j,i), 3 ) ) 228 ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) 248 229 ELSE 249 230 tend(k,j,i) = tend(k,j,i) - w(k,j,i) * & 250 ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) & 251 * MERGE( 1.0_wp, 0.0_wp, & 252 BTEST( wall_flags_0(k,j,i), 3 ) ) 231 ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) 253 232 ENDIF 254 233 -
palm/trunk/SOURCE/buoyancy.f90
r3294 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove unnecessary double-masking of topography 28 ! 29 ! 3294 2018-10-01 02:37:10Z raasch 27 30 ! module use statements moved to global declaration section 28 31 ! … … 152 155 USE indices, & 153 156 ONLY: nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nzb, & 154 nzt , wall_flags_0157 nzt 155 158 156 159 … … 179 182 ( var(k,j,i) - ref_state(k) ) / ref_state(k) + & 180 183 ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) & 181 ) * MERGE( 1.0_wp, 0.0_wp, & 182 BTEST( wall_flags_0(k,j,i), 0 ) ) 184 ) 183 185 ENDDO 184 186 ENDDO … … 200 202 0.5_wp * ( ( pt(k,j,i-1) + pt(k,j,i) ) & 201 203 - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) & 202 ) / pt_surface & 203 * MERGE( 1.0_wp, 0.0_wp, & 204 BTEST( wall_flags_0(k,j,i), 0 ) ) 204 ) / pt_surface 205 205 ENDDO 206 206 ENDDO … … 215 215 0.5_wp * ( ( pt(k,j,i) + pt(k+1,j,i) ) & 216 216 - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) & 217 ) / pt_surface & 218 * MERGE( 1.0_wp, 0.0_wp, & 219 BTEST( wall_flags_0(k,j,i), 0 ) ) 217 ) / pt_surface 220 218 ENDDO 221 219 ENDDO … … 247 245 248 246 USE indices, & 249 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt , wall_flags_0247 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt 250 248 251 249 IMPLICIT NONE … … 270 268 ( var(k,j,i) - ref_state(k) ) / ref_state(k) + & 271 269 ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) & 272 ) & 273 * MERGE( 1.0_wp, 0.0_wp, & 274 BTEST( wall_flags_0(k,j,i), 0 ) ) 270 ) 275 271 ENDDO 276 272 … … 288 284 0.5_wp * ( ( pt(k,j,i-1) + pt(k,j,i) ) & 289 285 - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) & 290 ) / pt_surface & 291 * MERGE( 1.0_wp, 0.0_wp, & 292 BTEST( wall_flags_0(k,j,i), 0 ) ) 286 ) / pt_surface 293 287 ENDDO 294 288 … … 299 293 0.5_wp * ( ( pt(k,j,i) + pt(k+1,j,i) ) & 300 294 - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) & 301 ) / pt_surface & 302 * MERGE( 1.0_wp, 0.0_wp, & 303 BTEST( wall_flags_0(k,j,i), 0 ) ) 295 ) / pt_surface 304 296 ENDDO 305 297 -
palm/trunk/SOURCE/coriolis.f90
r3241 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Note concerning topography masking added 28 ! 29 ! 3241 2018-09-12 15:02:00Z raasch 27 30 ! unused variables removed 28 31 ! … … 89 92 ! ------------ 90 93 !> Computation of all Coriolis terms in the equations of motion. 94 !> 95 !> @note In this routine the topography is masked, even though this 96 !> is again done in prognostic_equations. However, omitting the masking 97 !> here lead to slightly different results. Reason unknown. 91 98 !------------------------------------------------------------------------------! 92 99 MODULE coriolis_mod -
palm/trunk/SOURCE/init_grid.f90
r3294 r3538 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Comment added 28 ! 29 ! 3294 2018-10-01 02:37:10Z raasch 27 30 ! ocean renamed ocean_mode 28 31 ! … … 1647 1650 DO j = nys, nyn 1648 1651 DO k = nzb, nzt 1652 ! 1653 !-- Flag topography for all grid points which are below 1654 !-- the local topography height. 1655 !-- Note, each topography is flagged as building. 1649 1656 IF ( zu(k) - ocean_offset <= buildings_f%var_2d(j,i) ) THEN 1650 1657 topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 ) 1651 topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 ) !indicates terrain1658 topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 ) !indicates building 1652 1659 ENDIF 1653 1660 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
