Changeset 1320 for palm/trunk/SOURCE/coriolis.f90
- Timestamp:
- Mar 20, 2014 8:40:49 AM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/coriolis.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! kind-parameters added to all INTEGER and REAL declaration statements, 24 ! kinds are defined in new module kinds, 25 ! old module precision_kind is removed, 26 ! revision history before 2012 removed, 27 ! comment fields (!:) to be used for variable explanations added to 28 ! all variable declaration statements 23 29 ! 24 30 ! Former revisions: … … 38 44 ! 1015 2012-09-27 09:23:24Z raasch 39 45 ! accelerator version (*_acc) added 40 !41 ! 254 2009-03-05 15:33:42Z heinze42 ! Output of messages replaced by message handling routine.43 !44 ! 106 2007-08-16 14:30:26Z raasch45 ! loops for u and v are starting from index nxlu, nysv, respectively (needed46 ! for non-cyclic boundary conditions)47 !48 ! 75 2007-03-22 09:54:05Z raasch49 ! uxrp, vynp eliminated50 !51 ! RCS Log replace by Id keyword, revision history cleaned up52 !53 ! Revision 1.12 2006/02/23 10:08:57 raasch54 ! nzb_2d replaced by nzb_u/v/w_inner55 46 ! 56 47 ! Revision 1.1 1997/08/29 08:57:38 raasch … … 83 74 SUBROUTINE coriolis( component ) 84 75 85 USE arrays_3d 86 USE control_parameters 87 USE indices 88 USE pegrid 76 USE arrays_3d, & 77 ONLY: tend, u, ug, v, vg, w 78 79 USE control_parameters, & 80 ONLY: f, fs, message_string 81 82 USE indices, & 83 ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner, & 84 nzb_w_inner, nzt 85 86 USE kinds 89 87 90 88 IMPLICIT NONE 91 89 92 INTEGER :: component, i, j, k 90 INTEGER(iwp) :: component !: 91 INTEGER(iwp) :: i !: 92 INTEGER(iwp) :: j !: 93 INTEGER(iwp) :: k !: 93 94 94 95 … … 103 104 DO j = nys, nyn 104 105 DO k = nzb_u_inner(j,i)+1, nzt 105 tend(k,j,i) = tend(k,j,i) + f * ( 0.25 * &106 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &107 v(k,j+1,i) ) - vg(k) ) &108 - fs * ( 0.25 * &109 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &106 tend(k,j,i) = tend(k,j,i) + f * ( 0.25 * & 107 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + & 108 v(k,j+1,i) ) - vg(k) ) & 109 - fs * ( 0.25 * & 110 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + & 110 111 w(k,j,i) ) & 111 112 ) … … 120 121 DO j = nysv, nyn 121 122 DO k = nzb_v_inner(j,i)+1, nzt 122 tend(k,j,i) = tend(k,j,i) - f * ( 0.25 * &123 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &123 tend(k,j,i) = tend(k,j,i) - f * ( 0.25 * & 124 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + & 124 125 u(k,j,i+1) ) - ug(k) ) 125 126 ENDDO … … 133 134 DO j = nys, nyn 134 135 DO k = nzb_w_inner(j,i)+1, nzt 135 tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &136 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &136 tend(k,j,i) = tend(k,j,i) + fs * 0.25 * & 137 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + & 137 138 u(k+1,j,i+1) ) 138 139 ENDDO … … 155 156 SUBROUTINE coriolis_acc( component ) 156 157 157 USE arrays_3d 158 USE control_parameters 159 USE indices 160 USE pegrid 158 USE arrays_3d, & 159 ONLY: tend, u, ug, v, vg, w 160 161 USE control_parameters, & 162 ONLY: f, fs, message_string 163 164 USE indices, & 165 ONLY: i_left, i_right, j_north, j_south, nzb_u_inner, & 166 nzb_v_inner, nzb_w_inner, nzt 167 168 USE kinds 161 169 162 170 IMPLICIT NONE 163 171 164 INTEGER :: component, i, j, k 172 INTEGER(iwp) :: component !: 173 INTEGER(iwp) :: i !: 174 INTEGER(iwp) :: j !: 175 INTEGER(iwp) :: k !: 165 176 166 177 … … 215 226 DO k = 1, nzt 216 227 IF ( k > nzb_w_inner(j,i) ) THEN 217 tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &218 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &228 tend(k,j,i) = tend(k,j,i) + fs * 0.25 * & 229 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + & 219 230 u(k+1,j,i+1) ) 220 231 ENDIF … … 239 250 SUBROUTINE coriolis_ij( i, j, component ) 240 251 241 USE arrays_3d 242 USE control_parameters 243 USE indices 244 USE pegrid 245 252 USE arrays_3d, & 253 ONLY: tend, u, ug, v, vg, w 254 255 USE control_parameters, & 256 ONLY: f, fs, message_string 257 258 USE indices, & 259 ONLY: nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt 260 261 USE kinds 262 246 263 IMPLICIT NONE 247 264 248 INTEGER :: component, i, j, k 265 INTEGER(iwp) :: component !: 266 INTEGER(iwp) :: i !: 267 INTEGER(iwp) :: j !: 268 INTEGER(iwp) :: k !: 249 269 250 270 ! … … 256 276 CASE ( 1 ) 257 277 DO k = nzb_u_inner(j,i)+1, nzt 258 tend(k,j,i) = tend(k,j,i) + f * ( 0.25 * & 259 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + & 260 v(k,j+1,i) ) - vg(k) ) & 261 - fs * ( 0.25 * & 262 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + & 263 w(k,j,i) ) & 264 ) 278 tend(k,j,i) = tend(k,j,i) + f * ( 0.25 * & 279 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + & 280 v(k,j+1,i) ) - vg(k) ) & 281 - fs * ( 0.25 * & 282 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + & 283 w(k,j,i) ) ) 265 284 ENDDO 266 285 … … 269 288 CASE ( 2 ) 270 289 DO k = nzb_v_inner(j,i)+1, nzt 271 tend(k,j,i) = tend(k,j,i) - f * ( 0.25 * &272 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &290 tend(k,j,i) = tend(k,j,i) - f * ( 0.25 * & 291 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + & 273 292 u(k,j,i+1) ) - ug(k) ) 274 293 ENDDO … … 278 297 CASE ( 3 ) 279 298 DO k = nzb_w_inner(j,i)+1, nzt 280 tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &281 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &299 tend(k,j,i) = tend(k,j,i) + fs * 0.25 * & 300 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + & 282 301 u(k+1,j,i+1) ) 283 302 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.