Changeset 996
- Timestamp:
- Sep 7, 2012 10:41:47 AM (12 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 9 edited
-
boundary_conds.f90 (modified) (17 diffs)
-
check_parameters.f90 (modified) (4 diffs)
-
init_1d_model.f90 (modified) (6 diffs)
-
init_3d_model.f90 (modified) (13 diffs)
-
init_grid.f90 (modified) (2 diffs)
-
init_masks.f90 (modified) (8 diffs)
-
modules.f90 (modified) (2 diffs)
-
parin.f90 (modified) (5 diffs)
-
poismg.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/boundary_conds.f90
r979 r996 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! little reformatting 7 7 ! 8 8 ! Former revisions: … … 259 259 260 260 ! 261 !-- Calculate the phase speeds for u, v, and w, first local and then262 !-- average parallel along the outflow boundary.263 DO k = nzb+1, nzt+1264 DO i = nxl, nxr261 !-- Calculate the phase speeds for u, v, and w, first local and then 262 !-- average along the outflow boundary. 263 DO k = nzb+1, nzt+1 264 DO i = nxl, nxr 265 265 266 266 denom = u_m_s(k,0,i) - u_m_s(k,1,i) 267 267 268 268 IF ( denom /= 0.0 ) THEN 269 c_u(k,i) = -c_max * ( u(k,0,i) - u_m_s(k,0,i) ) & 270 / ( denom * tsc(2) ) 269 c_u(k,i) = -c_max * ( u(k,0,i) - u_m_s(k,0,i) ) / ( denom * tsc(2) ) 271 270 IF ( c_u(k,i) < 0.0 ) THEN 272 271 c_u(k,i) = 0.0 … … 281 280 282 281 IF ( denom /= 0.0 ) THEN 283 c_v(k,i) = -c_max * ( v(k,1,i) - v_m_s(k,1,i) ) & 284 / ( denom * tsc(2) ) 282 c_v(k,i) = -c_max * ( v(k,1,i) - v_m_s(k,1,i) ) / ( denom * tsc(2) ) 285 283 IF ( c_v(k,i) < 0.0 ) THEN 286 284 c_v(k,i) = 0.0 … … 295 293 296 294 IF ( denom /= 0.0 ) THEN 297 c_w(k,i) = -c_max * ( w(k,0,i) - w_m_s(k,0,i) ) & 298 / ( denom * tsc(2) ) 295 c_w(k,i) = -c_max * ( w(k,0,i) - w_m_s(k,0,i) ) / ( denom * tsc(2) ) 299 296 IF ( c_w(k,i) < 0.0 ) THEN 300 297 c_w(k,i) = 0.0 … … 343 340 ! 344 341 !-- Calculate the new velocities 345 DO k = nzb+1, nzt+1346 DO i = nxlg, nxrg342 DO k = nzb+1, nzt+1 343 DO i = nxlg, nxrg 347 344 u_p(k,-1,i) = u(k,-1,i) - dt_3d * tsc(2) * c_u_m(k) * & 348 345 ( u(k,-1,i) - u(k,0,i) ) * ddy … … 401 398 402 399 ! 403 !-- Calculate the phase speeds for u, v, and w, first local and then404 !-- average parallel along the outflow boundary.405 DO k = nzb+1, nzt+1406 DO i = nxl, nxr400 !-- Calculate the phase speeds for u, v, and w, first local and then 401 !-- average along the outflow boundary. 402 DO k = nzb+1, nzt+1 403 DO i = nxl, nxr 407 404 408 405 denom = u_m_n(k,ny,i) - u_m_n(k,ny-1,i) 409 406 410 407 IF ( denom /= 0.0 ) THEN 411 c_u(k,i) = -c_max * ( u(k,ny,i) - u_m_n(k,ny,i) ) & 412 / ( denom * tsc(2) ) 408 c_u(k,i) = -c_max * ( u(k,ny,i) - u_m_n(k,ny,i) ) / ( denom * tsc(2) ) 413 409 IF ( c_u(k,i) < 0.0 ) THEN 414 410 c_u(k,i) = 0.0 … … 423 419 424 420 IF ( denom /= 0.0 ) THEN 425 c_v(k,i) = -c_max * ( v(k,ny,i) - v_m_n(k,ny,i) ) & 426 / ( denom * tsc(2) ) 421 c_v(k,i) = -c_max * ( v(k,ny,i) - v_m_n(k,ny,i) ) / ( denom * tsc(2) ) 427 422 IF ( c_v(k,i) < 0.0 ) THEN 428 423 c_v(k,i) = 0.0 … … 437 432 438 433 IF ( denom /= 0.0 ) THEN 439 c_w(k,i) = -c_max * ( w(k,ny,i) - w_m_n(k,ny,i) ) & 440 / ( denom * tsc(2) ) 434 c_w(k,i) = -c_max * ( w(k,ny,i) - w_m_n(k,ny,i) ) / ( denom * tsc(2) ) 441 435 IF ( c_w(k,i) < 0.0 ) THEN 442 436 c_w(k,i) = 0.0 … … 485 479 ! 486 480 !-- Calculate the new velocities 487 DO k = nzb+1, nzt+1488 DO i = nxlg, nxrg481 DO k = nzb+1, nzt+1 482 DO i = nxlg, nxrg 489 483 u_p(k,ny+1,i) = u(k,ny+1,i) - dt_3d * tsc(2) * c_u_m(k) * & 490 484 ( u(k,ny+1,i) - u(k,ny,i) ) * ddy … … 543 537 544 538 ! 545 !-- Calculate the phase speeds for u, v, and w, first local and then546 !-- average parallel along the outflow boundary.547 DO k = nzb+1, nzt+1548 DO j = nys, nyn539 !-- Calculate the phase speeds for u, v, and w, first local and then 540 !-- average along the outflow boundary. 541 DO k = nzb+1, nzt+1 542 DO j = nys, nyn 549 543 550 544 denom = u_m_l(k,j,1) - u_m_l(k,j,2) 551 545 552 546 IF ( denom /= 0.0 ) THEN 553 c_u(k,j) = -c_max * ( u(k,j,1) - u_m_l(k,j,1) ) & 554 / ( denom * tsc(2) ) 547 c_u(k,j) = -c_max * ( u(k,j,1) - u_m_l(k,j,1) ) / ( denom * tsc(2) ) 555 548 IF ( c_u(k,j) < 0.0 ) THEN 556 549 c_u(k,j) = 0.0 … … 565 558 566 559 IF ( denom /= 0.0 ) THEN 567 c_v(k,j) = -c_max * ( v(k,j,0) - v_m_l(k,j,0) ) & 568 / ( denom * tsc(2) ) 560 c_v(k,j) = -c_max * ( v(k,j,0) - v_m_l(k,j,0) ) / ( denom * tsc(2) ) 569 561 IF ( c_v(k,j) < 0.0 ) THEN 570 562 c_v(k,j) = 0.0 … … 579 571 580 572 IF ( denom /= 0.0 ) THEN 581 c_w(k,j) = -c_max * ( w(k,j,0) - w_m_l(k,j,0) ) & 582 / ( denom * tsc(2) ) 573 c_w(k,j) = -c_max * ( w(k,j,0) - w_m_l(k,j,0) ) / ( denom * tsc(2) ) 583 574 IF ( c_w(k,j) < 0.0 ) THEN 584 575 c_w(k,j) = 0.0 … … 627 618 ! 628 619 !-- Calculate the new velocities 629 DO k = nzb+1, nzt+1630 DO i = nxlg, nxrg620 DO k = nzb+1, nzt+1 621 DO i = nxlg, nxrg 631 622 u_p(k,j,0) = u(k,j,0) - dt_3d * tsc(2) * c_u_m(k) * & 632 623 ( u(k,j,0) - u(k,j,1) ) * ddx … … 685 676 686 677 ! 687 !-- Calculate the phase speeds for u, v, and w, first local and then688 !-- average parallel along the outflow boundary.689 DO k = nzb+1, nzt+1690 DO j = nys, nyn678 !-- Calculate the phase speeds for u, v, and w, first local and then 679 !-- average along the outflow boundary. 680 DO k = nzb+1, nzt+1 681 DO j = nys, nyn 691 682 692 683 denom = u_m_r(k,j,nx) - u_m_r(k,j,nx-1) 693 684 694 685 IF ( denom /= 0.0 ) THEN 695 c_u(k,j) = -c_max * ( u(k,j,nx) - u_m_r(k,j,nx) ) & 696 / ( denom * tsc(2) ) 686 c_u(k,j) = -c_max * ( u(k,j,nx) - u_m_r(k,j,nx) ) / ( denom * tsc(2) ) 697 687 IF ( c_u(k,j) < 0.0 ) THEN 698 688 c_u(k,j) = 0.0 … … 707 697 708 698 IF ( denom /= 0.0 ) THEN 709 c_v(k,j) = -c_max * ( v(k,j,nx) - v_m_r(k,j,nx) ) & 710 / ( denom * tsc(2) ) 699 c_v(k,j) = -c_max * ( v(k,j,nx) - v_m_r(k,j,nx) ) / ( denom * tsc(2) ) 711 700 IF ( c_v(k,j) < 0.0 ) THEN 712 701 c_v(k,j) = 0.0 … … 721 710 722 711 IF ( denom /= 0.0 ) THEN 723 c_w(k,j) = -c_max * ( w(k,j,nx) - w_m_r(k,j,nx) ) & 724 / ( denom * tsc(2) ) 712 c_w(k,j) = -c_max * ( w(k,j,nx) - w_m_r(k,j,nx) ) / ( denom * tsc(2) ) 725 713 IF ( c_w(k,j) < 0.0 ) THEN 726 714 c_w(k,j) = 0.0 … … 769 757 ! 770 758 !-- Calculate the new velocities 771 DO k = nzb+1, nzt+1772 DO i = nxlg, nxrg759 DO k = nzb+1, nzt+1 760 DO i = nxlg, nxrg 773 761 u_p(k,j,nx+1) = u(k,j,nx+1) - dt_3d * tsc(2) * c_u_m(k) * & 774 762 ( u(k,j,nx+1) - u(k,j,nx) ) * ddx -
palm/trunk/SOURCE/check_parameters.f90
r979 r996 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! little reformatting 7 7 ! 8 8 ! Former revisions: … … 2712 2712 IF ( TRIM( var ) == 'u*' ) unit = 'm/s' 2713 2713 IF ( TRIM( var ) == 'z0*' ) unit = 'm' 2714 IF ( TRIM( var ) == 'z0h*' 2714 IF ( TRIM( var ) == 'z0h*' ) unit = 'm' 2715 2715 2716 2716 … … 2980 2980 !-- potential temperature, check the width of the damping layer 2981 2981 IF ( bc_lr /= 'cyclic' ) THEN 2982 IF ( pt_damping_width < 0.0 .OR.pt_damping_width > REAL( nx * dx ) ) THEN2982 IF ( pt_damping_width < 0.0 .OR. pt_damping_width > REAL( nx * dx ) ) THEN 2983 2983 message_string = 'pt_damping_width out of range' 2984 2984 CALL message( 'check_parameters', 'PA0124', 1, 2, 0, 6, 0 ) … … 2987 2987 2988 2988 IF ( bc_ns /= 'cyclic' ) THEN 2989 IF ( pt_damping_width < 0.0 .OR.pt_damping_width > REAL( ny * dy ) ) THEN2989 IF ( pt_damping_width < 0.0 .OR. pt_damping_width > REAL( ny * dy ) ) THEN 2990 2990 message_string = 'pt_damping_width out of range' 2991 2991 CALL message( 'check_parameters', 'PA0124', 1, 2, 0, 6, 0 ) -
palm/trunk/SOURCE/init_1d_model.f90
r979 r996 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! little reformatting 7 7 ! 8 8 ! Former revisions: … … 151 151 usws1d = 0.0; usws1d_m = 0.0 152 152 vsws1d = 0.0; vsws1d_m = 0.0 153 z01d = roughness_length153 z01d = roughness_length 154 154 z0h1d = z0h_factor * z01d 155 155 IF ( humidity .OR. passive_scalar ) qs1d = 0.0 … … 448 448 ! 449 449 !-- Stable stratification 450 ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &450 ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / & 451 451 ( LOG( zu(nzb+1) / z0h1d ) + 5.0 * rif1d(nzb+1) * & 452 452 ( zu(nzb+1) - z0h1d ) / zu(nzb+1) & … … 462 462 !-- occur in the argument of the logarithm. 463 463 IF ( a == 0.0 .OR. b == 0.0 ) THEN 464 ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &464 ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / & 465 465 ( LOG( zu(nzb+1) / z0h1d ) + 5.0 * rif1d(nzb+1) * & 466 466 ( zu(nzb+1) - z0h1d ) / zu(nzb+1) & … … 581 581 ! 582 582 !-- Stable stratification 583 qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &583 qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / & 584 584 ( LOG( zu(nzb+1) / z0h1d ) + 5.0 * rif1d(nzb+1) * & 585 585 ( zu(nzb+1) - z0h1d ) / zu(nzb+1) & … … 595 595 !-- occur in the argument of the logarithm. 596 596 IF ( a == 1.0 .OR. b == 1.0 ) THEN 597 qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &597 qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / & 598 598 ( LOG( zu(nzb+1) / z0h1d ) + 5.0 * rif1d(nzb+1) * & 599 599 ( zu(nzb+1) - z0h1d ) / zu(nzb+1) & -
palm/trunk/SOURCE/init_3d_model.f90
r979 r996 7 7 ! Current revisions: 8 8 ! ------------------ 9 ! 9 ! little reformatting 10 10 ! 11 11 ! Former revisions: … … 190 190 191 191 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ngp_2dh_outer_l, & 192 ngp_2dh_s_inner_l192 ngp_2dh_s_inner_l 193 193 194 194 REAL :: a, b … … 213 213 ngp_2dh_s_inner(nzb:nzt+1,0:statistic_regions), & 214 214 ngp_2dh_s_inner_l(nzb:nzt+1,0:statistic_regions), & 215 rmask(nysg:nyng,nxlg:nxrg,0:statistic_regions), &215 rmask(nysg:nyng,nxlg:nxrg,0:statistic_regions), & 216 216 sums(nzb:nzt+1,pr_palm+max_pr_user), & 217 217 sums_l(nzb:nzt+1,pr_palm+max_pr_user,0:threads_per_task-1), & … … 225 225 ts(nysg:nyng,nxlg:nxrg), tswst_1(nysg:nyng,nxlg:nxrg), & 226 226 us(nysg:nyng,nxlg:nxrg), usws_1(nysg:nyng,nxlg:nxrg), & 227 uswst_1(nysg:nyng,nxlg:nxrg), 228 vsws_1(nysg:nyng,nxlg:nxrg), 229 vswst_1(nysg:nyng,nxlg:nxrg), z0(nysg:nyng,nxlg:nxrg), 227 uswst_1(nysg:nyng,nxlg:nxrg), & 228 vsws_1(nysg:nyng,nxlg:nxrg), & 229 vswst_1(nysg:nyng,nxlg:nxrg), z0(nysg:nyng,nxlg:nxrg), & 230 230 z0h(nysg:nyng,nxlg:nxrg) ) 231 231 … … 242 242 ENDIF 243 243 244 ALLOCATE( d(nzb+1:nzta,nys:nyna,nxl:nxra), 244 ALLOCATE( d(nzb+1:nzta,nys:nyna,nxl:nxra), & 245 245 e_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 246 246 e_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & … … 256 256 u_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 257 257 u_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 258 v_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &259 v_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &260 v_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &258 v_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 259 v_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 260 v_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 261 261 w_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 262 262 w_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & … … 374 374 375 375 IF ( passive_scalar ) THEN 376 ALLOCATE ( sls(nzb:nzt+1,nysg:nyng,nxlg:nxrg), 376 ALLOCATE ( sls(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 377 377 sec(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 378 378 ENDIF 379 379 380 380 IF ( cthf /= 0.0 ) THEN 381 ALLOCATE ( lai(nzb:nzt+1,nysg:nyng,nxlg:nxrg), 381 ALLOCATE ( lai(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 382 382 canopy_heat_flux(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 383 383 ENDIF … … 423 423 c_w(nzb:nzt+1,nxlg:nxrg) ) 424 424 ENDIF 425 IF ( outflow_l .OR. outflow_r .OR. outflow_s .OR.outflow_n ) THEN425 IF ( outflow_l .OR. outflow_r .OR. outflow_s .OR. outflow_n ) THEN 426 426 ALLOCATE( c_u_m_l(nzb:nzt+1), c_v_m_l(nzb:nzt+1), c_w_m_l(nzb:nzt+1) ) 427 427 ALLOCATE( c_u_m(nzb:nzt+1), c_v_m(nzb:nzt+1), c_w_m(nzb:nzt+1) ) … … 601 601 !-- --------- advection scheme: keep u and v zero one layer below 602 602 !-- the topography. 603 !604 !-- Following was removed, because mirror boundary condition are605 !-- replaced by dirichlet boundary conditions606 !607 ! IF ( ibc_uv_b == 0 ) THEN608 !!609 !!-- Satisfying the Dirichlet condition with an extra layer below610 !!-- the surface where the u and v component change their sign.611 ! DO i = nxl-1, nxr+1612 ! DO j = nys-1, nyn+1613 ! IF ( nzb_u_inner(j,i) == 0 ) u(0,j,i) = -u(1,j,i)614 ! IF ( nzb_v_inner(j,i) == 0 ) v(0,j,i) = -v(1,j,i)615 ! ENDDO616 ! ENDDO617 !618 ! ELSE619 603 IF ( ibc_uv_b == 1 ) THEN 620 604 ! … … 1073 1057 IF ( zu(k) <= inflow_damping_height ) THEN 1074 1058 inflow_damping_factor(k) = 1.0 1075 ELSEIF ( zu(k) <= inflow_damping_height + & 1076 inflow_damping_width ) THEN 1077 inflow_damping_factor(k) = 1.0 - & 1078 ( zu(k) - inflow_damping_height ) / & 1079 inflow_damping_width 1059 ELSEIF ( zu(k) <= ( inflow_damping_height + inflow_damping_width ) ) THEN 1060 inflow_damping_factor(k) = 1.0 - & 1061 ( zu(k) - inflow_damping_height ) / & 1062 inflow_damping_width 1080 1063 ELSE 1081 1064 inflow_damping_factor(k) = 0.0 … … 1097 1080 DO i = nxlg, nxrg 1098 1081 DO j = nysg, nyng 1099 u (nzb:nzb_u_inner(j,i),j,i) = 0.01100 v (nzb:nzb_v_inner(j,i),j,i) = 0.01101 w (nzb:nzb_w_inner(j,i),j,i) = 0.01102 e (nzb:nzb_w_inner(j,i),j,i) = 0.01103 u_m(nzb:nzb_u_inner(j,i),j,i) = 0.01104 v_m(nzb:nzb_v_inner(j,i),j,i) = 0.01105 w_m(nzb:nzb_w_inner(j,i),j,i) = 0.01106 e_m(nzb:nzb_w_inner(j,i),j,i) = 0.01107 tu_m(nzb:nzb_u_inner(j,i),j,i) = 0.01108 tv_m(nzb:nzb_v_inner(j,i),j,i) = 0.01109 tw_m(nzb:nzb_w_inner(j,i),j,i) = 0.01110 te_m(nzb:nzb_w_inner(j,i),j,i) = 0.01082 u (nzb:nzb_u_inner(j,i),j,i) = 0.0 1083 v (nzb:nzb_v_inner(j,i),j,i) = 0.0 1084 w (nzb:nzb_w_inner(j,i),j,i) = 0.0 1085 e (nzb:nzb_w_inner(j,i),j,i) = 0.0 1086 u_m(nzb:nzb_u_inner(j,i),j,i) = 0.0 1087 v_m(nzb:nzb_v_inner(j,i),j,i) = 0.0 1088 w_m(nzb:nzb_w_inner(j,i),j,i) = 0.0 1089 e_m(nzb:nzb_w_inner(j,i),j,i) = 0.0 1090 tu_m(nzb:nzb_u_inner(j,i),j,i) = 0.0 1091 tv_m(nzb:nzb_v_inner(j,i),j,i) = 0.0 1092 tw_m(nzb:nzb_w_inner(j,i),j,i) = 0.0 1093 te_m(nzb:nzb_w_inner(j,i),j,i) = 0.0 1111 1094 tpt_m(nzb:nzb_w_inner(j,i),j,i) = 0.0 1112 1095 ENDDO … … 1554 1537 ptdf_x = 0.0 1555 1538 ptdf_y = 0.0 1556 IF ( bc_lr_dirrad .OR.bc_lr_dirneu ) THEN1557 DO i = nxl, nxr1539 IF ( bc_lr_dirrad .OR. bc_lr_dirneu ) THEN 1540 DO i = nxl, nxr 1558 1541 IF ( ( i * dx ) < pt_damping_width ) THEN 1559 1542 ptdf_x(i) = pt_damping_factor * ( SIN( pi * 0.5 * & … … 1562 1545 ENDIF 1563 1546 ENDDO 1564 ELSEIF ( bc_lr_raddir .OR.bc_lr_neudir ) THEN1565 DO i = nxl, nxr1547 ELSEIF ( bc_lr_raddir .OR. bc_lr_neudir ) THEN 1548 DO i = nxl, nxr 1566 1549 IF ( ( i * dx ) > ( nx * dx - pt_damping_width ) ) THEN 1567 ptdf_x(i) = pt_damping_factor * ( SIN( pi * 0.5 *&1568 REAL( ( i - nx ) * dx + pt_damping_width ) / (&1569 REAL( pt_damping_width ) ) ) )**21550 ptdf_x(i) = pt_damping_factor * & 1551 SIN( pi * 0.5 * ( ( i - nx ) * dx + pt_damping_width ) / & 1552 REAL( pt_damping_width ) )**2 1570 1553 ENDIF 1571 1554 ENDDO 1572 ELSEIF ( bc_ns_dirrad .OR.bc_ns_dirneu ) THEN1573 DO j = nys, nyn1555 ELSEIF ( bc_ns_dirrad .OR. bc_ns_dirneu ) THEN 1556 DO j = nys, nyn 1574 1557 IF ( ( j * dy ) > ( ny * dy - pt_damping_width ) ) THEN 1575 ptdf_y(j) = pt_damping_factor * ( SIN( pi * 0.5 *&1576 REAL( ( j - ny ) * dy + pt_damping_width ) / (&1577 REAL( pt_damping_width ) ) ) )**21558 ptdf_y(j) = pt_damping_factor * & 1559 SIN( pi * 0.5 * ( ( j - ny ) * dy + pt_damping_width ) / & 1560 REAL( pt_damping_width ) )**2 1578 1561 ENDIF 1579 1562 ENDDO 1580 ELSEIF ( bc_ns_raddir .OR.bc_ns_neudir ) THEN1581 DO j = nys, nyn1563 ELSEIF ( bc_ns_raddir .OR. bc_ns_neudir ) THEN 1564 DO j = nys, nyn 1582 1565 IF ( ( j * dy ) < pt_damping_width ) THEN 1583 ptdf_y(j) = pt_damping_factor * ( SIN( pi * 0.5 *&1584 REAL( pt_damping_width - j * dy ) / (&1585 REAL( pt_damping_width ) ) ) )**21566 ptdf_y(j) = pt_damping_factor * & 1567 SIN( pi * 0.5 * ( pt_damping_width - j * dy ) / & 1568 REAL( pt_damping_width ) )**2 1586 1569 ENDIF 1587 1570 ENDDO -
palm/trunk/SOURCE/init_grid.f90
r979 r996 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! little reformatting 7 7 ! 8 8 ! Former revisions: … … 613 613 !-- steering the degradation of order of the applied advection scheme. 614 614 !-- In case of non-cyclic lateral boundaries, the order of the advection 615 !-- scheme is reduced at the lateral boundaries up to nzt.615 !-- scheme have to be reduced up to nzt (required at the lateral boundaries). 616 616 nzb_max = MAXVAL( nzb_local ) 617 617 IF ( inflow_l .OR. outflow_l .OR. inflow_r .OR. outflow_r .OR. & -
palm/trunk/SOURCE/init_masks.f90
r979 r996 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! little reformatting 7 7 ! 8 8 ! Former revisions: … … 80 80 !-- Parallel mask output not yet tested 81 81 IF ( netcdf_data_format > 2 ) THEN 82 message_string = ' NetCDF file formats '// &83 '3 ( NetCDF 4) and 4 (NetCDF 4 Classic model)'// &82 message_string = 'netCDF file formats '// & 83 '3 (netCDF 4) and 4 (netCDF 4 Classic model)'// & 84 84 '&are currently not supported (not yet tested).' 85 85 CALL message( 'init_masks', 'PA0328', 1, 2, 0, 6, 0 ) … … 88 88 ! 89 89 !-- Store data output parameters for masked data output in few shared arrays 90 DO mid = 1, masks90 DO mid = 1, masks 91 91 92 92 do_mask (mid,:) = data_output_masks(mid,:) … … 96 96 mask (mid,3,:) = mask_z(mid,:) 97 97 98 IF ( mask_x_loop(mid,1) == -1.0 .AND.mask_x_loop(mid,2) == -1.0 &99 .AND. mask_x_loop(mid,3) == -1.0 )THEN100 98 IF ( mask_x_loop(mid,1) == -1.0 .AND. mask_x_loop(mid,2) == -1.0 & 99 .AND. mask_x_loop(mid,3) == -1.0 ) THEN 100 mask_loop(mid,1,1:2) = -1.0 101 101 mask_loop(mid,1,3) = 0.0 102 102 ELSE 103 103 mask_loop(mid,1,:) = mask_x_loop(mid,:) 104 104 ENDIF 105 IF ( mask_y_loop(mid,1) == -1.0 .AND.mask_y_loop(mid,2) == -1.0 &106 .AND. mask_y_loop(mid,3) == -1.0 )THEN107 105 IF ( mask_y_loop(mid,1) == -1.0 .AND. mask_y_loop(mid,2) == -1.0 & 106 .AND. mask_y_loop(mid,3) == -1.0 ) THEN 107 mask_loop(mid,2,1:2) = -1.0 108 108 mask_loop(mid,2,3) = 0.0 109 109 ELSE 110 110 mask_loop(mid,2,:) = mask_y_loop(mid,:) 111 111 ENDIF 112 IF ( mask_z_loop(mid,1) == -1.0 .AND.mask_z_loop(mid,2) == -1.0 &113 .AND. mask_z_loop(mid,3) == -1.0 )THEN114 112 IF ( mask_z_loop(mid,1) == -1.0 .AND. mask_z_loop(mid,2) == -1.0 & 113 .AND. mask_z_loop(mid,3) == -1.0 ) THEN 114 mask_loop(mid,3,1:2) = -1.0 115 115 mask_loop(mid,3,3) = 0.0 116 116 ELSE … … 158 158 !-- Check and set steering parameters for mask data output and averaging 159 159 i = 1 160 DO 160 DO WHILE ( do_mask(mid,i) /= ' ' .AND. i <= 100 ) 161 161 ! 162 162 !-- Check for data averaging … … 265 265 'for horizontal cross section' 266 266 CALL message( 'init_masks', 'PA0111', 1, 2, 0, 6, 0 ) 267 ! IF ( TRIM( var ) == 'lwp*' .AND. .NOT. cloud_physics ) THEN268 ! WRITE ( message_string, * ) 'output of "', TRIM( var ), &269 ! '" requires cloud_physics = .TRUE.'270 ! CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 )271 ! ENDIF272 ! IF ( TRIM( var ) == 'pra*' .AND. .NOT. precipitation ) THEN273 ! WRITE ( message_string, * ) 'output of "', TRIM( var ), &274 ! '" requires precipitation = .TRUE.'275 ! CALL message( 'init_masks', 'PA0112', 1, 2, 0, 6, 0 )276 ! ENDIF277 ! IF ( TRIM( var ) == 'pra*' .AND. j == 1 ) THEN278 ! WRITE ( message_string, * ) 'temporal averaging of ', &279 ! ' precipitation amount "', TRIM( var ), &280 ! '" not possible'281 ! CALL message( 'init_masks', 'PA0113', 1, 2, 0, 6, 0 )282 ! ENDIF283 ! IF ( TRIM( var ) == 'prr*' .AND. .NOT. precipitation ) THEN284 ! WRITE ( message_string, * ) 'output of "', TRIM( var ), &285 ! '" requires precipitation = .TRUE.'286 ! CALL message( 'init_masks', 'PA0112', 1, 2, 0, 6, 0 )287 ! ENDIF288 !289 ! IF ( TRIM( var ) == 'u*' ) unit = 'm/s'290 ! IF ( TRIM( var ) == 't*' ) unit = 'K'291 ! IF ( TRIM( var ) == 'lwp*' ) unit = 'kg/kg*m'292 ! IF ( TRIM( var ) == 'pra*' ) unit = 'mm'293 ! IF ( TRIM( var ) == 'prr*' ) unit = 'mm/s'294 ! IF ( TRIM( var ) == 'z0*' ) unit = 'm'295 267 296 268 CASE ( 'p', 'pt', 'u', 'v', 'w' ) … … 404 376 !-- If at least part of the mask resides on the PE, send the index limits 405 377 !-- for the target array, otherwise send -9999 to PE0. 406 IF ( mask_size_l(mid,1) > 0 .AND. mask_size_l(mid,2) > 0 .AND. & 407 mask_size_l(mid,3) > 0 ) & 408 THEN 378 IF ( mask_size_l(mid,1) > 0 .AND. mask_size_l(mid,2) > 0 .AND. & 379 mask_size_l(mid,3) > 0 ) THEN 409 380 ind(1) = mask_start_l(mid,1) 410 381 ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1 … … 599 570 DO m = loop_begin, loop_end, loop_stride 600 571 count = count + 1 601 IF ( m >= lb .AND.m <= ub ) THEN572 IF ( m >= lb .AND. m <= ub ) THEN 602 573 IF ( count_l == 0 ) mask_start_l(mid,dim) = count 603 574 count_l = count_l + 1 -
palm/trunk/SOURCE/modules.f90
r979 r996 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! -use_prior_plot1d_parameters 7 7 ! 8 8 ! Former revisions: … … 627 627 stop_dt = .FALSE., synchronous_exchange = .FALSE., & 628 628 terminate_run = .FALSE., turbulent_inflow = .FALSE., & 629 use_prescribed_profile_data = .FALSE., & 630 use_prior_plot1d_parameters = .FALSE., use_reference = .FALSE.,& 629 use_prescribed_profile_data = .FALSE., use_reference = .FALSE.,& 631 630 use_surface_fluxes = .FALSE., use_top_fluxes = .FALSE., & 632 631 use_ug_for_galilei_tr = .TRUE., use_upstream_for_tke = .FALSE.,& -
palm/trunk/SOURCE/parin.f90
r979 r996 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! -use_prior_plot1d_parameters 7 7 ! 8 8 ! Former revisions: … … 229 229 skip_time_do2d_xz, skip_time_do2d_yz, skip_time_do3d, & 230 230 skip_time_domask, synchronous_exchange, termination_time_needed, & 231 use_prior_plot1d_parameters,z_max_do2d231 z_max_do2d 232 232 233 233 … … 276 276 ! 277 277 !-- Read the control parameters for initialization. 278 !-- The namelist "inipar" must be provided in the NAMELIST-file. If this 279 !-- is not the case and the file contains - instead of "inipar" - any 280 !-- other namelist, a read error is created on t3e and control is 281 !-- transferred to the statement with label 10. Therefore, on t3e 282 !-- machines one can not distinguish between errors produced by a wrong 283 !-- "inipar" namelist or because this namelist is totally missing. 284 READ ( 11, inipar, ERR=10, END=11 ) 278 !-- The namelist "inipar" must be provided in the NAMELIST-file. 279 READ ( 11, inipar, ERR=10, END=11 ) 285 280 286 281 #if defined ( __check ) … … 289 284 !-- used. The p3d file here must be closed and the p3df file for reading 290 285 !-- 3dpar is opened. 291 IF ( check_restart == 1 ) THEN286 IF ( check_restart == 1 ) THEN 292 287 CALL close_file( 11 ) 293 288 check_restart = 2 294 289 CALL check_open( 11 ) 295 290 initializing_actions = 'read_restart_data' 296 END 291 ENDIF 297 292 #endif 298 293 GOTO 12 299 294 300 295 10 message_string = 'errors in \$inipar &or no \$inipar-namelist ' // & … … 309 304 !-- a prior run). All PEs are reading from file created by PE0 (see 310 305 !-- check_open) 311 312 313 306 12 IF ( TRIM( initializing_actions ) == 'read_restart_data' ) THEN 314 307 #if ! defined ( __check ) -
palm/trunk/SOURCE/poismg.f90
r979 r996 7 7 ! Current revisions: 8 8 ! ----------------- 9 ! 9 ! little reformatting 10 10 ! 11 11 ! Former revisions: … … 1232 1232 !-- outflow conditions have to be used on all PEs after the switch, 1233 1233 !-- because then they have the total domain. 1234 IF ( bc_lr_dirrad .OR.bc_lr_dirneu ) THEN1234 IF ( bc_lr_dirrad .OR. bc_lr_dirneu ) THEN 1235 1235 inflow_l = .TRUE. 1236 1236 inflow_r = .FALSE. 1237 1237 outflow_l = .FALSE. 1238 1238 outflow_r = .TRUE. 1239 ELSEIF ( bc_lr_raddir .OR.bc_lr_neudir ) THEN1239 ELSEIF ( bc_lr_raddir .OR. bc_lr_neudir ) THEN 1240 1240 inflow_l = .FALSE. 1241 1241 inflow_r = .TRUE. … … 1244 1244 ENDIF 1245 1245 1246 IF ( bc_ns_dirrad .OR.bc_ns_dirneu ) THEN1246 IF ( bc_ns_dirrad .OR. bc_ns_dirneu ) THEN 1247 1247 inflow_n = .TRUE. 1248 1248 inflow_s = .FALSE. 1249 1249 outflow_n = .FALSE. 1250 1250 outflow_s = .TRUE. 1251 ELSEIF ( bc_ns_raddir .OR.bc_ns_neudir ) THEN1251 ELSEIF ( bc_ns_raddir .OR. bc_ns_neudir ) THEN 1252 1252 inflow_n = .FALSE. 1253 1253 inflow_s = .TRUE. … … 1319 1319 1320 1320 IF ( pleft == MPI_PROC_NULL ) THEN 1321 IF ( bc_lr_dirrad .OR.bc_lr_dirneu ) THEN1321 IF ( bc_lr_dirrad .OR. bc_lr_dirneu ) THEN 1322 1322 inflow_l = .TRUE. 1323 ELSEIF ( bc_lr_raddir .OR.bc_lr_neudir ) THEN1323 ELSEIF ( bc_lr_raddir .OR. bc_lr_neudir ) THEN 1324 1324 outflow_l = .TRUE. 1325 1325 ENDIF … … 1327 1327 1328 1328 IF ( pright == MPI_PROC_NULL ) THEN 1329 IF ( bc_lr_dirrad .OR.bc_lr_dirneu ) THEN1329 IF ( bc_lr_dirrad .OR. bc_lr_dirneu ) THEN 1330 1330 outflow_r = .TRUE. 1331 ELSEIF ( bc_lr_raddir .OR.bc_lr_neudir ) THEN1331 ELSEIF ( bc_lr_raddir .OR. bc_lr_neudir ) THEN 1332 1332 inflow_r = .TRUE. 1333 1333 ENDIF … … 1335 1335 1336 1336 IF ( psouth == MPI_PROC_NULL ) THEN 1337 IF ( bc_ns_dirrad .OR.bc_ns_dirneu ) THEN1337 IF ( bc_ns_dirrad .OR. bc_ns_dirneu ) THEN 1338 1338 outflow_s = .TRUE. 1339 ELSEIF ( bc_ns_raddir .OR.bc_ns_neudir ) THEN1339 ELSEIF ( bc_ns_raddir .OR. bc_ns_neudir ) THEN 1340 1340 inflow_s = .TRUE. 1341 1341 ENDIF … … 1343 1343 1344 1344 IF ( pnorth == MPI_PROC_NULL ) THEN 1345 IF ( bc_ns_dirrad .OR.bc_ns_dirneu ) THEN1345 IF ( bc_ns_dirrad .OR. bc_ns_dirneu ) THEN 1346 1346 inflow_n = .TRUE. 1347 ELSEIF ( bc_ns_raddir .OR.bc_ns_neudir ) THEN1347 ELSEIF ( bc_ns_raddir .OR. bc_ns_neudir ) THEN 1348 1348 outflow_n = .TRUE. 1349 1349 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
