Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

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

Adjustments according new topography and surface-modelling concept implemented

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/coriolis.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    102102           
    103103       USE indices,                                                            &
    104            ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner,    &
    105                   nzb_w_inner, nzt
     104           ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, wall_flags_0
    106105                   
    107106       USE kinds
    … …  
    110109
    111110       INTEGER(iwp) ::  component  !<
    112        INTEGER(iwp) ::  i          !<
    113        INTEGER(iwp) ::  j          !<
    114        INTEGER(iwp) ::  k          !<
    115 
    116 
     111       INTEGER(iwp) ::  i          !< running index x direction
     112       INTEGER(iwp) ::  j          !< running index y direction
     113       INTEGER(iwp) ::  k          !< running index z direction
     114
     115       REAL(wp)     ::  flag       !< flag to mask topography
    117116!
    118117!--    Compute Coriolis terms for the three velocity components
    … …  
    124123             DO  i = nxlu, nxr
    125124                DO  j = nys, nyn
    126                    DO  k = nzb_u_inner(j,i)+1, nzt
     125                   DO  k = nzb+1, nzt
     126!
     127!--                    Predetermine flag to mask topography
     128                      flag = MERGE( 1.0_wp, 0.0_wp,                            &
     129                                    BTEST( wall_flags_0(k,j,i), 1 ) )
     130
    127131                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *          &
    128132                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +    &
    129                                      v(k,j+1,i) ) - vg(k) )                    &
     133                                     v(k,j+1,i) ) - vg(k)   ) * flag           &
    130134                                                - fs *    ( 0.25_wp *          &
    131135                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +  &
    132                                      w(k,j,i)   ) &
    133                                                           )
     136                                     w(k,j,i)   )                              &
     137                                                          )   * flag
    134138                   ENDDO
    135139                ENDDO
    … …  
    141145             DO  i = nxl, nxr
    142146                DO  j = nysv, nyn
    143                    DO  k = nzb_v_inner(j,i)+1, nzt
     147                   DO  k = nzb+1, nzt
    144148                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *          &
    145149                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +    &
    146                                      u(k,j,i+1) ) - ug(k) )
     150                                     u(k,j,i+1) ) - ug(k) ) *                  &
     151                                      MERGE( 1.0_wp, 0.0_wp,                   &
     152                                             BTEST( wall_flags_0(k,j,i), 2 ) )
    147153                   ENDDO
    148154                ENDDO
    … …  
    154160             DO  i = nxl, nxr
    155161                DO  j = nys, nyn
    156                    DO  k = nzb_w_inner(j,i)+1, nzt
     162                   DO  k = nzb+1, nzt
    157163                      tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *               &
    158164                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +      &
    159                                      u(k+1,j,i+1) )
     165                                     u(k+1,j,i+1) ) *                          &
     166                                      MERGE( 1.0_wp, 0.0_wp,                   &
     167                                             BTEST( wall_flags_0(k,j,i), 3 ) )
    160168                   ENDDO
    161169                ENDDO
    … …  
    186194           
    187195       USE indices,                                                            &
    188            ONLY:  nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
     196           ONLY:  nzb, nzt, wall_flags_0
    189197           
    190198       USE kinds
    … …  
    193201
    194202       INTEGER(iwp) ::  component  !<
    195        INTEGER(iwp) ::  i          !<
    196        INTEGER(iwp) ::  j          !<
    197        INTEGER(iwp) ::  k          !<
     203       INTEGER(iwp) ::  i          !< running index x direction
     204       INTEGER(iwp) ::  j          !< running index y direction
     205       INTEGER(iwp) ::  k          !< running index z direction
     206
     207       REAL(wp)     ::  flag       !< flag to mask topography
    198208
    199209!
    … …  
    204214!--       u-component
    205215          CASE ( 1 )
    206              DO  k = nzb_u_inner(j,i)+1, nzt
    207                 tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *                &
     216             DO  k = nzb+1, nzt
     217!
     218!--             Predetermine flag to mask topography
     219                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
     220
     221                tend(k,j,i) = tend(k,j,i) + f  *     ( 0.25_wp *               &
    208222                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +       &
    209                                   v(k,j+1,i) ) - vg(k) )                       &
     223                                  v(k,j+1,i) ) - vg(k) ) * flag                &
    210224                                          - fs *    ( 0.25_wp *                &
    211225                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +     &
    212                                   w(k,j,i)   ) )
     226                                  w(k,j,i)   )      ) * flag
    213227             ENDDO
    214228
    … …  
    216230!--       v-component
    217231          CASE ( 2 )
    218              DO  k = nzb_v_inner(j,i)+1, nzt
    219                 tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *                &
     232             DO  k = nzb+1, nzt
     233                tend(k,j,i) = tend(k,j,i) - f *        ( 0.25_wp *             &
    220234                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +       &
    221                                   u(k,j,i+1) ) - ug(k) )
     235                                  u(k,j,i+1) ) - ug(k) ) *                     &
     236                                      MERGE( 1.0_wp, 0.0_wp,                   &
     237                                             BTEST( wall_flags_0(k,j,i), 2 ) )
    222238             ENDDO
    223239
    … …  
    225241!--       w-component
    226242          CASE ( 3 )
    227              DO  k = nzb_w_inner(j,i)+1, nzt
     243             DO  k = nzb+1, nzt
    228244                tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *                     &
    229245                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +         &
    230                                   u(k+1,j,i+1) )
     246                                  u(k+1,j,i+1) ) *                             &
     247                                      MERGE( 1.0_wp, 0.0_wp,                   &
     248                                             BTEST( wall_flags_0(k,j,i), 3 ) )
    231249             ENDDO
    232250
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |