Changeset 1320 for palm/trunk/SOURCE/diffusion_w.f90
- Timestamp:
- Mar 20, 2014 8:40:49 AM (10 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/diffusion_w.f90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/diffusion_w.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: … … 48 54 ! kmym_y/_z and kmyp_y/_z change to kmym and kmyp 49 55 ! 50 ! 667 2010-12-23 12:06:00Z suehring/gryschka51 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng52 !53 ! 366 2009-08-25 08:06:27Z raasch54 ! bc_lr/bc_ns replaced by bc_lr_cyc/bc_ns_cyc55 !56 ! 75 2007-03-22 09:54:05Z raasch57 ! Wall functions now include diabatic conditions, call of routine wall_fluxes,58 ! z0 removed from argument list59 !60 ! 20 2007-02-26 00:12:32Z raasch61 ! Bugfix: ddzw dimensioned 1:nzt"+1"62 !63 ! RCS Log replace by Id keyword, revision history cleaned up64 !65 ! Revision 1.12 2006/02/23 10:38:03 raasch66 ! nzb_2d replaced by nzb_w_outer, wall functions added for all vertical walls,67 ! +z0 in argument list68 ! WARNING: loops containing the MAX function are still not properly vectorized!69 !70 56 ! Revision 1.1 1997/09/12 06:24:11 raasch 71 57 ! Initial revision … … 77 63 !------------------------------------------------------------------------------! 78 64 79 USE wall_fluxes_mod 65 USE wall_fluxes_mod, & 66 ONLY : wall_fluxes, wall_fluxes_acc 80 67 81 68 PRIVATE … … 99 86 SUBROUTINE diffusion_w 100 87 101 USE arrays_3d 102 USE control_parameters 103 USE grid_variables 104 USE indices 88 USE arrays_3d, & 89 ONLY : ddzu, ddzw, km, tend, u, v, w 90 91 USE control_parameters, & 92 ONLY : topography 93 94 USE grid_variables, & 95 ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y 96 97 USE indices, & 98 ONLY : nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt 99 100 USE kinds 105 101 106 102 IMPLICIT NONE 107 103 108 INTEGER :: i, j, k 109 REAL :: kmxm, kmxp, kmym, kmyp 110 111 REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus, wsvs 104 INTEGER(iwp) :: i !: 105 INTEGER(iwp) :: j !: 106 INTEGER(iwp) :: k !: 107 108 REAL(wp) :: kmxm !: 109 REAL(wp) :: kmxp !: 110 REAL(wp) :: kmym !: 111 REAL(wp) :: kmyp !: 112 113 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus !: 114 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsvs !: 112 115 113 116 … … 116 119 !-- walls, if neccessary 117 120 IF ( topography /= 'flat' ) THEN 118 CALL wall_fluxes( wsus, 0.0 , 0.0, 0.0, 1.0, nzb_w_inner,&121 CALL wall_fluxes( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, nzb_w_inner, & 119 122 nzb_w_outer, wall_w_x ) 120 CALL wall_fluxes( wsvs, 0.0 , 0.0, 1.0, 0.0, nzb_w_inner,&123 CALL wall_fluxes( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, nzb_w_inner, & 121 124 nzb_w_outer, wall_w_y ) 122 125 ENDIF … … 208 211 SUBROUTINE diffusion_w_acc 209 212 210 USE arrays_3d 211 USE control_parameters 212 USE grid_variables 213 USE indices 213 USE arrays_3d, & 214 ONLY : ddzu, ddzw, km, tend, u, v, w 215 216 USE control_parameters, & 217 ONLY : topography 218 219 USE grid_variables, & 220 ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y 221 222 USE indices, & 223 ONLY : i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb, & 224 nzb_w_inner, nzb_w_outer, nzt 225 226 USE kinds 214 227 215 228 IMPLICIT NONE 216 229 217 INTEGER :: i, j, k 218 REAL :: kmxm, kmxp, kmym, kmyp 219 220 REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus, wsvs 230 INTEGER(iwp) :: i !: 231 INTEGER(iwp) :: j !: 232 INTEGER(iwp) :: k !: 233 234 REAL(wp) :: kmxm !: 235 REAL(wp) :: kmxp !: 236 REAL(wp) :: kmym !: 237 REAL(wp) :: kmyp !: 238 239 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus !: 240 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsvs !: 221 241 !$acc declare create ( wsus, wsvs ) 222 242 … … 225 245 !-- walls, if neccessary 226 246 IF ( topography /= 'flat' ) THEN 227 CALL wall_fluxes_acc( wsus, 0.0 , 0.0, 0.0, 1.0, nzb_w_inner,&228 nzb_w_ outer, wall_w_x )229 CALL wall_fluxes_acc( wsvs, 0.0 , 0.0, 1.0, 0.0, nzb_w_inner,&230 nzb_w_ outer, wall_w_y )247 CALL wall_fluxes_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, & 248 nzb_w_inner, nzb_w_outer, wall_w_x ) 249 CALL wall_fluxes_acc( wsvs, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, & 250 nzb_w_inner, nzb_w_outer, wall_w_y ) 231 251 ENDIF 232 252 … … 324 344 SUBROUTINE diffusion_w_ij( i, j ) 325 345 326 USE arrays_3d 327 USE control_parameters 328 USE grid_variables 329 USE indices 346 USE arrays_3d, & 347 ONLY : ddzu, ddzw, km, tend, u, v, w 348 349 USE control_parameters, & 350 ONLY : topography 351 352 USE grid_variables, & 353 ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y 354 355 USE indices, & 356 ONLY : nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt 357 358 USE kinds 330 359 331 360 IMPLICIT NONE 332 361 333 INTEGER :: i, j, k 334 REAL :: kmxm, kmxp, kmym, kmyp 335 336 REAL, DIMENSION(nzb:nzt+1) :: wsus, wsvs 362 INTEGER(iwp) :: i !: 363 INTEGER(iwp) :: j !: 364 INTEGER(iwp) :: k !: 365 366 REAL(wp) :: kmxm !: 367 REAL(wp) :: kmxp !: 368 REAL(wp) :: kmym !: 369 REAL(wp) :: kmyp !: 370 371 REAL(wp), DIMENSION(nzb:nzt+1) :: wsus 372 REAL(wp), DIMENSION(nzb:nzt+1) :: wsvs 337 373 338 374 … … 369 405 !-- Calculate the horizontal momentum fluxes w'u' and/or w'v' 370 406 IF ( wall_w_x(j,i) /= 0.0 ) THEN 371 CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &372 wsus, 0.0 , 0.0, 0.0, 1.0)407 CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), & 408 wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp ) 373 409 ELSE 374 410 wsus = 0.0 … … 376 412 377 413 IF ( wall_w_y(j,i) /= 0.0 ) THEN 378 CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &379 wsvs, 0.0 , 0.0, 1.0, 0.0)414 CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), & 415 wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp ) 380 416 ELSE 381 417 wsvs = 0.0
Note: See TracChangeset
for help on using the changeset viewer.
