Ignore:
Timestamp:
May 30, 2017 5:47:52 PM (4 years ago)
Author:
suehring
Message:

Adjustments according new topography and surface-modelling concept implemented

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/lpm_init_sgs_tke.f90

    r2101 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments according to new topography realization
    2323!
    2424! Former revisions:
     
    7373
    7474    USE indices,                                                               &
    75         ONLY:  nbgp, ngp_2dh_outer, nxl, nxr, nyn, nys, nzb, nzb_s_inner,      &
    76                nzb_s_outer, nzt
     75        ONLY:  nbgp, ngp_2dh_outer, nxl, nxr, nyn, nys, nzb,                   &
     76               nzb_s_outer, nzt, wall_flags_0
    7777
    7878    USE kinds
     
    8686        ONLY:  flow_statistics_called, hom, sums, sums_l
    8787
     88    USE surface_mod,                                                           &
     89        ONLY:  bc_h
     90
    8891    IMPLICIT NONE
    8992
    90     INTEGER(iwp) ::  i      !<
    91     INTEGER(iwp) ::  j      !<
    92     INTEGER(iwp) ::  k      !<
    93 
     93    INTEGER(iwp) ::  i      !< index variable along x
     94    INTEGER(iwp) ::  j      !< index variable along y
     95    INTEGER(iwp) ::  k      !< index variable along z
     96    INTEGER(iwp) ::  m      !< running index for the surface elements
     97
     98    REAL(wp) ::  flag1      !< flag to mask topography
    9499
    95100!
     
    99104          DO  k = nzb, nzt+1
    100105
    101              IF ( k <= nzb_s_inner(j,i-1)  .AND.  k > nzb_s_inner(j,i)  .AND.  &
    102                   k  > nzb_s_inner(j,i+1) )                                    &
     106             IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 )  .AND.               &
     107                        BTEST( wall_flags_0(k,j,i), 0   )  .AND.               &
     108                        BTEST( wall_flags_0(k,j,i+1), 0 ) )                    &
    103109             THEN
    104110                de_dx(k,j,i) = 2.0_wp * sgs_wf_part *                          &
    105111                               ( e(k,j,i+1) - e(k,j,i) ) * ddx
    106              ELSEIF ( k  > nzb_s_inner(j,i-1)  .AND.  k > nzb_s_inner(j,i)     &
    107                       .AND.  k <= nzb_s_inner(j,i+1) )                         &
     112             ELSEIF ( BTEST( wall_flags_0(k,j,i-1), 0 )  .AND.                 &
     113                      BTEST( wall_flags_0(k,j,i), 0   )  .AND.                 &
     114                .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )                      &
    108115             THEN
    109116                de_dx(k,j,i) = 2.0_wp * sgs_wf_part *                          &
    110117                               ( e(k,j,i) - e(k,j,i-1) ) * ddx
    111              ELSEIF ( k < nzb_s_inner(j,i)  .AND.  k < nzb_s_inner(j,i+1) )    &
     118             ELSEIF ( .NOT. BTEST( wall_flags_0(k,j,i), 22   )  .AND.          &
     119                      .NOT. BTEST( wall_flags_0(k,j,i+1), 22 ) )               &   
    112120             THEN
    113121                de_dx(k,j,i) = 0.0_wp
    114              ELSEIF ( k < nzb_s_inner(j,i-1)  .AND.  k < nzb_s_inner(j,i) )    &
     122             ELSEIF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 22 )  .AND.          &
     123                      .NOT. BTEST( wall_flags_0(k,j,i), 22   ) )               &
    115124             THEN
    116125                de_dx(k,j,i) = 0.0_wp
     
    119128             ENDIF
    120129
    121              IF ( k <= nzb_s_inner(j-1,i)  .AND.  k > nzb_s_inner(j,i)  .AND.  &
    122                   k  > nzb_s_inner(j+1,i) )                                    &
     130             IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 )  .AND.               &
     131                        BTEST( wall_flags_0(k,j,i), 0   )  .AND.               &
     132                        BTEST( wall_flags_0(k,j+1,i), 0 ) )                    &
    123133             THEN
    124134                de_dy(k,j,i) = 2.0_wp * sgs_wf_part *                          &
    125135                               ( e(k,j+1,i) - e(k,j,i) ) * ddy
    126              ELSEIF ( k  > nzb_s_inner(j-1,i)  .AND.  k  > nzb_s_inner(j,i)    &
    127                       .AND.  k <= nzb_s_inner(j+1,i) )                         &
     136             ELSEIF ( BTEST( wall_flags_0(k,j-1,i), 0 )  .AND.                 &
     137                      BTEST( wall_flags_0(k,j,i), 0   )  .AND.                 &
     138                .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )                      &
    128139             THEN
    129140                de_dy(k,j,i) = 2.0_wp * sgs_wf_part *                          &
    130141                               ( e(k,j,i) - e(k,j-1,i) ) * ddy
    131              ELSEIF ( k < nzb_s_inner(j,i)  .AND.  k < nzb_s_inner(j+1,i) )    &
     142             ELSEIF ( .NOT. BTEST( wall_flags_0(k,j,i), 22   )  .AND.          &
     143                      .NOT. BTEST( wall_flags_0(k,j+1,i), 22 ) )               &   
    132144             THEN
    133145                de_dy(k,j,i) = 0.0_wp
    134              ELSEIF ( k < nzb_s_inner(j-1,i)  .AND.  k < nzb_s_inner(j,i) )    &
     146             ELSEIF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 22 )  .AND.          &
     147                      .NOT. BTEST( wall_flags_0(k,j,i), 22   ) )               &
    135148             THEN
    136149                de_dy(k,j,i) = 0.0_wp
     
    144157
    145158!
    146 !-- TKE gradient along z, including bottom and top boundary conditions
     159!-- TKE gradient along z at topograhy and including bottom and top boundary conditions
    147160    DO  i = nxl, nxr
    148161       DO  j = nys, nyn
    149 
    150           DO  k = nzb_s_inner(j,i)+2, nzt-1
    151              de_dz(k,j,i)  = 2.0_wp * sgs_wf_part *                            &
    152                              ( e(k+1,j,i) - e(k-1,j,i) ) / ( zu(k+1)-zu(k-1) )
    153           ENDDO
    154 
    155           k = nzb_s_inner(j,i)
    156           de_dz(nzb:k,j,i) = 0.0_wp
    157           de_dz(k+1,j,i)   = 2.0_wp * sgs_wf_part *                            &
    158                              ( e(k+2,j,i) - e(k+1,j,i) ) / ( zu(k+2) - zu(k+1) )
     162          DO  k = nzb+1, nzt-1
     163!
     164!--          Flag to mask topography
     165             flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0  ) )
     166
     167             de_dz(k,j,i) = 2.0_wp * sgs_wf_part *                             &
     168                           ( e(k+1,j,i) - e(k-1,j,i) ) / ( zu(k+1) - zu(k-1) ) &
     169                                                 * flag1
     170          ENDDO
     171!
     172!--       upward-facing surfaces
     173          DO  m = bc_h(0)%start_index(j,i), bc_h(0)%end_index(j,i)
     174             k            = bc_h(0)%k(m)
     175             de_dz(k,j,i) = 2.0_wp * sgs_wf_part *                             &
     176                           ( e(k+1,j,i) - e(k,j,i)   ) / ( zu(k+1) - zu(k) )
     177          ENDDO
     178!
     179!--       downward-facing surfaces
     180          DO  m = bc_h(1)%start_index(j,i), bc_h(1)%end_index(j,i)
     181             k            = bc_h(1)%k(m)
     182             de_dz(k,j,i) = 2.0_wp * sgs_wf_part *                             &
     183                           ( e(k,j,i) - e(k-1,j,i)   ) / ( zu(k) - zu(k-1) )
     184          ENDDO
     185
     186          de_dz(nzb,j,i)   = 0.0_wp
    159187          de_dz(nzt,j,i)   = 0.0_wp
    160188          de_dz(nzt+1,j,i) = 0.0_wp
    161189       ENDDO
    162190    ENDDO
    163 
    164 
    165 !
    166 !-- Lateral boundary conditions
     191!
     192!-- Ghost point exchange
    167193    CALL exchange_horiz( de_dx, nbgp )
    168194    CALL exchange_horiz( de_dy, nbgp )
     
    185211       DO  i = nxl, nxr
    186212          DO  j =  nys, nyn
    187              DO  k = nzb_s_outer(j,i), nzt+1
    188                 sums_l(k,1,0)  = sums_l(k,1,0)  + u(k,j,i)
    189                 sums_l(k,2,0)  = sums_l(k,2,0)  + v(k,j,i)
     213             DO  k = nzb, nzt+1
     214!
     215!--             Flag indicate nzb_s_outer
     216                flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 24 ) )
     217
     218                sums_l(k,1,0)  = sums_l(k,1,0)  + u(k,j,i) * flag1
     219                sums_l(k,2,0)  = sums_l(k,2,0)  + v(k,j,i) * flag1
    190220             ENDDO
    191221          ENDDO
     
    221251       DO  i = nxl, nxr
    222252          DO  j = nys, nyn
    223              DO  k = nzb_s_outer(j,i), nzt+1
    224                 sums_l(k,8,0)  = sums_l(k,8,0)  + e(k,j,i)
    225                 sums_l(k,30,0) = sums_l(k,30,0) + ( u(k,j,i) - hom(k,1,1,0) )**2
    226                 sums_l(k,31,0) = sums_l(k,31,0) + ( v(k,j,i) - hom(k,1,2,0) )**2
    227                 sums_l(k,32,0) = sums_l(k,32,0) + w(k,j,i)**2
     253             DO  k = nzb, nzt+1
     254!
     255!--             Flag indicate nzb_s_outer
     256                flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 24 ) )
     257
     258                sums_l(k,8,0)  = sums_l(k,8,0)  + e(k,j,i)                       * flag1
     259                sums_l(k,30,0) = sums_l(k,30,0) + ( u(k,j,i) - hom(k,1,1,0) )**2 * flag1
     260                sums_l(k,31,0) = sums_l(k,31,0) + ( v(k,j,i) - hom(k,1,2,0) )**2 * flag1
     261                sums_l(k,32,0) = sums_l(k,32,0) + w(k,j,i)**2                    * flag1
    228262             ENDDO
    229263          ENDDO
Note: See TracChangeset for help on using the changeset viewer.