Changeset 996 for palm/trunk/SOURCE/init_3d_model.f90
- Timestamp:
- Sep 7, 2012 10:41:47 AM (12 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/init_3d_model.f90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
