Ignore:
Timestamp:
Apr 8, 2014 3:21:23 PM (7 years ago)
Author:
heinze
Message:

REAL constants provided with KIND-attribute

File:
1 edited

Legend:

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

    r1323 r1353  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! REAL constants provided with KIND-attribute
    2323!
    2424! Former revisions:
     
    105105               f2_mg, f3_mg, l_grid, l_wall, zu, zw
    106106       
    107     USE control_parameters,                                                             &
     107    USE control_parameters,                                                    &
    108108        ONLY:  bc_lr, bc_ns, building_height, building_length_x,               &
    109109               building_length_y, building_wall_left, building_wall_south,     &
     
    201201!
    202202!-- Allocate grid arrays
    203     ALLOCATE( ddzu(1:nzt+1), ddzw(1:nzt+1), dd2zu(1:nzt), dzu(1:nzt+1), &
     203    ALLOCATE( ddzu(1:nzt+1), ddzw(1:nzt+1), dd2zu(1:nzt), dzu(1:nzt+1),        &
    204204              dzw(1:nzt+1), l_grid(1:nzt), zu(nzb:nzt+1), zw(nzb:nzt+1) )
    205205
    206206!
    207207!-- Compute height of u-levels from constant grid length and dz stretch factors
    208     IF ( dz == -1.0 )  THEN
     208    IF ( dz == -1.0_wp )  THEN
    209209       message_string = 'missing dz'
    210210       CALL message( 'init_grid', 'PA0200', 1, 2, 0, 6, 0 )
    211     ELSEIF ( dz <= 0.0 )  THEN
     211    ELSEIF ( dz <= 0.0_wp )  THEN
    212212       WRITE( message_string, * ) 'dz=',dz,' <= 0.0'
    213213       CALL message( 'init_grid', 'PA0201', 1, 2, 0, 6, 0 )
     
    223223
    224224       IF ( ibc_uv_b == 0 .OR. ibc_uv_b == 2 ) THEN
    225           zu(0) = 0.0
    226       !    zu(0) = - dz * 0.5
     225          zu(0) = 0.0_wp
     226      !    zu(0) = - dz * 0.5_wp
    227227       ELSE
    228           zu(0) = - dz * 0.5
     228          zu(0) = - dz * 0.5_wp
    229229       ENDIF
    230        zu(1) =   dz * 0.5
     230       zu(1) =   dz * 0.5_wp
    231231
    232232       dz_stretch_level_index = nzt+1
     
    246246!--    ground the first u- and w-level (k=0) are defined at same height (z=0).
    247247!--    The top w-level is extrapolated linearly.
    248        zw(0) = 0.0
     248       zw(0) = 0.0_wp
    249249       DO  k = 1, nzt
    250           zw(k) = ( zu(k) + zu(k+1) ) * 0.5
    251        ENDDO
    252        zw(nzt+1) = zw(nzt) + 2.0 * ( zu(nzt+1) - zw(nzt) )
     250          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
     251       ENDDO
     252       zw(nzt+1) = zw(nzt) + 2.0_wp * ( zu(nzt+1) - zw(nzt) )
    253253
    254254    ELSE
     
    259259!--    w-level are defined at same height, but staggered from the second level.
    260260!--    The second u-level (k=1) corresponds to the top of the Prandtl-layer.
    261        zu(nzt+1) =   dz * 0.5
    262        zu(nzt)   = - dz * 0.5
     261       zu(nzt+1) =   dz * 0.5_wp
     262       zu(nzt)   = - dz * 0.5_wp
    263263
    264264       dz_stretch_level_index = 0
     
    281281!--    consistency, since w and all scalar variables are defined up tp nzt+1.
    282282       zw(nzt+1) = dz
    283        zw(nzt)   = 0.0
     283       zw(nzt)   = 0.0_wp
    284284       DO  k = 0, nzt
    285           zw(k) = ( zu(k) + zu(k+1) ) * 0.5
     285          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
    286286       ENDDO
    287287
     
    299299    DO  k = 1, nzt+1
    300300       dzu(k)  = zu(k) - zu(k-1)
    301        ddzu(k) = 1.0 / dzu(k)
     301       ddzu(k) = 1.0_wp / dzu(k)
    302302       dzw(k)  = zw(k) - zw(k-1)
    303        ddzw(k) = 1.0 / dzw(k)
     303       ddzw(k) = 1.0_wp / dzw(k)
    304304    ENDDO
    305305
    306306    DO  k = 1, nzt
    307        dd2zu(k) = 1.0 / ( dzu(k) + dzu(k+1) )
     307       dd2zu(k) = 1.0_wp / ( dzu(k) + dzu(k+1) )
    308308    ENDDO
    309309   
     
    340340       nzt_l = nzt
    341341       DO  l = maximum_grid_level-1, 1, -1
    342            dzu_mg(nzb+1,l) = 2.0 * dzu_mg(nzb+1,l+1)
    343            dzw_mg(nzb+1,l) = 2.0 * dzw_mg(nzb+1,l+1)
     342           dzu_mg(nzb+1,l) = 2.0_wp * dzu_mg(nzb+1,l+1)
     343           dzw_mg(nzb+1,l) = 2.0_wp * dzw_mg(nzb+1,l+1)
    344344           nzt_l = nzt_l / 2
    345345           DO  k = 2, nzt_l+1
     
    353353       dy_l  = dy
    354354       DO  l = maximum_grid_level, 1, -1
    355           ddx2_mg(l) = 1.0 / dx_l**2
    356           ddy2_mg(l) = 1.0 / dy_l**2
     355          ddx2_mg(l) = 1.0_wp / dx_l**2
     356          ddy2_mg(l) = 1.0_wp / dy_l**2
    357357          DO  k = nzb+1, nzt_l
    358              f2_mg(k,l) = 1.0 / ( dzu_mg(k+1,l) * dzw_mg(k,l) )
    359              f3_mg(k,l) = 1.0 / ( dzu_mg(k,l)   * dzw_mg(k,l) )
    360              f1_mg(k,l) = 2.0 * ( ddx2_mg(l) + ddy2_mg(l) ) + &
     358             f2_mg(k,l) = 1.0_wp / ( dzu_mg(k+1,l) * dzw_mg(k,l) )
     359             f3_mg(k,l) = 1.0_wp / ( dzu_mg(k,l)   * dzw_mg(k,l) )
     360             f1_mg(k,l) = 2.0_wp * ( ddx2_mg(l) + ddy2_mg(l) ) + &
    361361                          f2_mg(k,l) + f3_mg(k,l)
    362362          ENDDO
    363363          nzt_l = nzt_l / 2
    364           dx_l  = dx_l * 2.0
    365           dy_l  = dy_l * 2.0
     364          dx_l  = dx_l * 2.0_wp
     365          dy_l  = dy_l * 2.0_wp
    366366       ENDDO
    367367
     
    370370!
    371371!-- Compute the reciprocal values of the horizontal grid lengths.
    372     ddx = 1.0 / dx
    373     ddy = 1.0 / dy
     372    ddx = 1.0_wp / dx
     373    ddy = 1.0_wp / dy
    374374    dx2 = dx * dx
    375375    dy2 = dy * dy
    376     ddx2 = 1.0 / dx2
    377     ddy2 = 1.0 / dy2
     376    ddx2 = 1.0_wp / dx2
     377    ddy2 = 1.0_wp / dy2
    378378
    379379!
     
    433433    nzb_w_inner = nzb;  nzb_w_outer = nzb
    434434
    435     rflags_s_inner = 1.0
    436     rflags_invers  = 1.0
     435    rflags_s_inner = 1.0_wp
     436    rflags_invers  = 1.0_wp
    437437
    438438!
     
    453453    nzb_diff_u = nzb_diff;  nzb_diff_v = nzb_diff
    454454
    455     wall_e_x = 0.0;  wall_e_y = 0.0;  wall_u = 0.0;  wall_v = 0.0
    456     wall_w_x = 0.0;  wall_w_y = 0.0
    457     fwxp = 1.0;  fwxm = 1.0;  fwyp = 1.0;  fwym = 1.0
    458     fxp  = 1.0;  fxm  = 1.0;  fyp  = 1.0;  fym  = 1.0
     455    wall_e_x = 0.0_wp;  wall_e_y = 0.0_wp;  wall_u = 0.0_wp;  wall_v = 0.0_wp
     456    wall_w_x = 0.0_wp;  wall_w_y = 0.0_wp
     457    fwxp = 1.0_wp;  fwxm = 1.0_wp;  fwyp = 1.0_wp;  fwym = 1.0_wp
     458    fxp  = 1.0_wp;  fxm  = 1.0_wp;  fyp  = 1.0_wp;  fym  = 1.0_wp
    459459
    460460!
     
    471471    DO  k = 1, nzt
    472472       vertical_influence(k) = MIN ( INT( l_grid(k) / &
    473                      ( wall_adjustment_factor * dzw(k) ) + 0.5 ), nzt - k )
     473                     ( wall_adjustment_factor * dzw(k) ) + 0.5_wp ), nzt - k )
    474474    ENDDO
    475475
    476476    DO  k = 1, MAXVAL( nzb_s_inner )
    477        IF ( l_grid(k) > 1.5 * dx * wall_adjustment_factor .OR.  &
    478             l_grid(k) > 1.5 * dy * wall_adjustment_factor )  THEN
     477       IF ( l_grid(k) > 1.5_wp * dx * wall_adjustment_factor .OR.  &
     478            l_grid(k) > 1.5_wp * dy * wall_adjustment_factor )  THEN
    479479          WRITE( message_string, * ) 'grid anisotropy exceeds ', &
    480480                                     'threshold given by only local', &
     
    582582!--       Street canyon size has to meet some requirements
    583583          IF ( canyon_width_x /= 9999999.9_wp )  THEN
    584              IF ( ( cxl < 1 ) .OR. ( cxr > nx-1 ) .OR. ( cwx < 3 ) .OR.  &
     584             IF ( ( cxl < 1 ) .OR. ( cxr > nx-1 ) .OR. ( cwx < 3 ) .OR.        &
    585585               ( ch < 3 ) )  THEN
    586                 WRITE( message_string, * ) 'inconsistent canyon parameters:', &
    587                                            '&cxl=', cxl, 'cxr=', cxr,         &
    588                                            'cwx=', cwx,                       &
     586                WRITE( message_string, * ) 'inconsistent canyon parameters:',  &
     587                                           '&cxl=', cxl, 'cxr=', cxr,          &
     588                                           'cwx=', cwx,                        &
    589589                                           'ch=', ch, 'nx=', nx, 'ny=', ny
    590590                CALL message( 'init_grid', 'PA0205', 1, 2, 0, 6, 0 )
    591591             ENDIF
    592592          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
    593              IF ( ( cys < 1 ) .OR. ( cyn > ny-1 ) .OR. ( cwy < 3 ) .OR.  &
     593             IF ( ( cys < 1 ) .OR. ( cyn > ny-1 ) .OR. ( cwy < 3 ) .OR.        &
    594594               ( ch < 3 ) )  THEN
    595                 WRITE( message_string, * ) 'inconsistent canyon parameters:', &
    596                                            '&cys=', cys, 'cyn=', cyn,         &
    597                                            'cwy=', cwy,                       &
     595                WRITE( message_string, * ) 'inconsistent canyon parameters:',  &
     596                                           '&cys=', cys, 'cyn=', cyn,          &
     597                                           'cwy=', cwy,                        &
    598598                                           'ch=', ch, 'nx=', nx, 'ny=', ny
    599599                CALL message( 'init_grid', 'PA0206', 1, 2, 0, 6, 0 )
    600600             ENDIF
    601601          ENDIF
    602           IF ( canyon_width_x /= 9999999.9_wp .AND. canyon_width_y /= 9999999.9_wp ) &
    603                THEN
    604              message_string = 'inconsistent canyon parameters:' //     & 
    605                               '&street canyon can only be oriented' // &
     602          IF ( canyon_width_x /= 9999999.9_wp .AND.                            &                 
     603               canyon_width_y /= 9999999.9_wp )  THEN
     604             message_string = 'inconsistent canyon parameters:' //             &  
     605                              '&street canyon can only be oriented' //         &
    606606                              '&either in x- or in y-direction'
    607607             CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
     
    679679!-- scheme have to be reduced up to nzt (required at the lateral boundaries).
    680680    nzb_max = MAXVAL( nzb_local )
    681     IF ( inflow_l .OR. outflow_l .OR. inflow_r .OR. outflow_r .OR.    &
     681    IF ( inflow_l .OR. outflow_l .OR. inflow_r .OR. outflow_r .OR.             &
    682682         inflow_n .OR. outflow_n .OR. inflow_s .OR. outflow_s )  THEN
    683683         nzb_max = nzt
     
    693693!--    Consistency checks
    694694       IF ( MINVAL( nzb_local ) < 0  .OR.  MAXVAL( nzb_local ) > nz + 1 )  THEN
    695           WRITE( message_string, * ) 'nzb_local values are outside the',      &
    696                                 'model domain',                               &
    697                                 '&MINVAL( nzb_local ) = ', MINVAL(nzb_local), &
     695          WRITE( message_string, * ) 'nzb_local values are outside the',       &
     696                                'model domain',                                &
     697                                '&MINVAL( nzb_local ) = ', MINVAL(nzb_local),  &
    698698                                '&MAXVAL( nzb_local ) = ', MAXVAL(nzb_local)
    699699          CALL message( 'init_grid', 'PA0210', 1, 2, 0, 6, 0 )
     
    701701
    702702       IF ( bc_lr == 'cyclic' )  THEN
    703           IF ( ANY( nzb_local(:,-1) /= nzb_local(:,nx)   )  .OR. &
     703          IF ( ANY( nzb_local(:,-1) /= nzb_local(:,nx)   )  .OR.               &
    704704               ANY( nzb_local(:,0)  /= nzb_local(:,nx+1) ) )  THEN
    705              message_string = 'nzb_local does not fulfill cyclic' // &
     705             message_string = 'nzb_local does not fulfill cyclic' //           &
    706706                              ' boundary condition in x-direction'
    707707             CALL message( 'init_grid', 'PA0211', 1, 2, 0, 6, 0 )
     
    709709       ENDIF
    710710       IF ( bc_ns == 'cyclic' )  THEN
    711           IF ( ANY( nzb_local(-1,:) /= nzb_local(ny,:)   )  .OR. &
     711          IF ( ANY( nzb_local(-1,:) /= nzb_local(ny,:)   )  .OR.               &
    712712               ANY( nzb_local(0,:)  /= nzb_local(ny+1,:) ) )  THEN
    713              message_string = 'nzb_local does not fulfill cyclic' // &
     713             message_string = 'nzb_local does not fulfill cyclic' //           &
    714714                              ' boundary condition in y-direction'
    715715             CALL message( 'init_grid', 'PA0212', 1, 2, 0, 6, 0 )
     
    770770       DO  j = -1, ny + 1
    771771          DO  i = 0, nx
    772              nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i), &
     772             nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i),             &
    773773                                 nzb_local(j,i+1) )
    774774          ENDDO
     
    776776       DO  i = nxl, nxr
    777777          DO  j = nys, nyn
    778              nzb_s_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i), &
     778             nzb_s_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i),             &
    779779                                     nzb_tmp(j+1,i) )
    780780          ENDDO
     
    812812       DO  i = nxl, nxr
    813813          DO  j = nys, nyn
    814              nzb_u_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i), &
     814             nzb_u_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i),             &
    815815                                     nzb_tmp(j+1,i) )
    816816          ENDDO
     
    844844       DO  j = nys, nyn
    845845          DO  i = nxl, nxr
    846              nzb_v_outer(j,i) = MAX( nzb_tmp(j,i-1), nzb_tmp(j,i), &
     846             nzb_v_outer(j,i) = MAX( nzb_tmp(j,i-1), nzb_tmp(j,i),             &
    847847                                     nzb_tmp(j,i+1) )
    848848          ENDDO
     
    891891          DO  j = nysg, nyng
    892892             DO  k = nzb, nzt+1
    893                 IF ( k <= nzb_s_inner(j,i) )  rflags_s_inner(k,j,i) = 0.0
    894                 IF ( k <= nzb_s_inner(j,i) )  rflags_invers(j,i,k)  = 0.0
     893                IF ( k <= nzb_s_inner(j,i) )  rflags_s_inner(k,j,i) = 0.0_wp
     894                IF ( k <= nzb_s_inner(j,i) )  rflags_invers(j,i,k)  = 0.0_wp
    895895             ENDDO
    896896          ENDDO
     
    938938!--       u-component
    939939          IF ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) )  THEN
    940              wall_u(j,i) = 1.0   ! north wall (location of adjacent fluid)
    941              fym(j,i)    = 0.0
    942              fyp(j,i)    = 1.0
     940             wall_u(j,i) = 1.0_wp   ! north wall (location of adjacent fluid)
     941             fym(j,i)    = 0.0_wp
     942             fyp(j,i)    = 1.0_wp
    943943          ELSEIF ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) )  THEN
    944              wall_u(j,i) = 1.0   ! south wall (location of adjacent fluid)
    945              fym(j,i)    = 1.0
    946              fyp(j,i)    = 0.0
     944             wall_u(j,i) = 1.0_wp   ! south wall (location of adjacent fluid)
     945             fym(j,i)    = 1.0_wp
     946             fyp(j,i)    = 0.0_wp
    947947          ENDIF
    948948!
    949949!--       v-component
    950950          IF ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  THEN
    951              wall_v(j,i) = 1.0   ! rigth wall (location of adjacent fluid)
    952              fxm(j,i)    = 0.0
    953              fxp(j,i)    = 1.0
     951             wall_v(j,i) = 1.0_wp   ! rigth wall (location of adjacent fluid)
     952             fxm(j,i)    = 0.0_wp
     953             fxp(j,i)    = 1.0_wp
    954954          ELSEIF ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  THEN
    955              wall_v(j,i) = 1.0   ! left wall (location of adjacent fluid)
    956              fxm(j,i)    = 1.0
    957              fxp(j,i)    = 0.0
     955             wall_v(j,i) = 1.0_wp   ! left wall (location of adjacent fluid)
     956             fxm(j,i)    = 1.0_wp
     957             fxp(j,i)    = 0.0_wp
    958958          ENDIF
    959959!
     
    961961!--       production of tke
    962962          IF ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  THEN
    963              wall_e_y(j,i) =  1.0   ! north wall (location of adjacent fluid)
    964              wall_w_y(j,i) =  1.0
    965              fwym(j,i)     =  0.0
    966              fwyp(j,i)     =  1.0
     963             wall_e_y(j,i) =  1.0_wp   ! north wall (location of adjacent fluid)
     964             wall_w_y(j,i) =  1.0_wp
     965             fwym(j,i)     =  0.0_wp
     966             fwyp(j,i)     =  1.0_wp
    967967          ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  THEN
    968              wall_e_y(j,i) = -1.0   ! south wall (location of adjacent fluid)
    969              wall_w_y(j,i) =  1.0
    970              fwym(j,i)     =  1.0
    971              fwyp(j,i)     =  0.0
     968             wall_e_y(j,i) = -1.0_wp   ! south wall (location of adjacent fluid)
     969             wall_w_y(j,i) =  1.0_wp
     970             fwym(j,i)     =  1.0_wp
     971             fwyp(j,i)     =  0.0_wp
    972972          ENDIF
    973973          IF ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  THEN
    974              wall_e_x(j,i) =  1.0   ! right wall (location of adjacent fluid)
    975              wall_w_x(j,i) =  1.0
    976              fwxm(j,i)     =  0.0
    977              fwxp(j,i)     =  1.0
     974             wall_e_x(j,i) =  1.0_wp   ! right wall (location of adjacent fluid)
     975             wall_w_x(j,i) =  1.0_wp
     976             fwxm(j,i)     =  0.0_wp
     977             fwxp(j,i)     =  1.0_wp
    978978          ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  THEN
    979              wall_e_x(j,i) = -1.0   ! left wall (location of adjacent fluid)
    980              wall_w_x(j,i) =  1.0
    981              fwxm(j,i)     =  1.0
    982              fwxp(j,i)     =  0.0
     979             wall_e_x(j,i) = -1.0_wp   ! left wall (location of adjacent fluid)
     980             wall_w_x(j,i) =  1.0_wp
     981             fwxm(j,i)     =  1.0_wp
     982             fwxp(j,i)     =  0.0_wp
    983983          ENDIF
    984984!
     
    13991399!--             North wall (y distance)
    14001400                DO  k = wall_n(j,i), nzb_si
    1401                    l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i), 0.5 * dy )
     1401                   l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i), 0.5_wp * dy )
    14021402                ENDDO
    14031403!
    14041404!--             Above North wall (yz distance)
    14051405                DO  k = nzb_si + 1, nzb_si + vi
    1406                    l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i),     &
    1407                                           SQRT( 0.25 * dy**2 + &
     1406                   l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i),                     &
     1407                                          SQRT( 0.25_wp * dy**2 +              &
    14081408                                          ( zu(k) - zw(nzb_si) )**2 ) )
    14091409                ENDDO
     
    14131413                   DO  k = corner_nl(j,i), nzb_si
    14141414                      l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1), &
    1415                                                0.5 * SQRT( dx**2 + dy**2 ) )
     1415                                               0.5_wp * SQRT( dx**2 + dy**2 ) )
    14161416                   ENDDO
    14171417!
    14181418!--                Above Northleft corner (xyz distance)
    14191419                   DO  k = nzb_si + 1, nzb_si + vi
    1420                       l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1),             &
    1421                                                SQRT( 0.25 * (dx**2 + dy**2) + &
    1422                                                ( zu(k) - zw(nzb_si) )**2 ) )
     1420                      l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1),              &
     1421                                            SQRT( 0.25_wp * (dx**2 + dy**2) + &
     1422                                            ( zu(k) - zw(nzb_si) )**2 ) )
    14231423                   ENDDO
    14241424                ENDIF
     
    14271427                IF ( corner_nr(j,i) > 0 )  THEN
    14281428                   DO  k = corner_nr(j,i), nzb_si
    1429                        l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1), &
    1430                                                 0.5 * SQRT( dx**2 + dy**2 ) )
     1429                       l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1),             &
     1430                                                0.5_wp * SQRT( dx**2 + dy**2 ) )
    14311431                   ENDDO
    14321432!
    14331433!--                Above northright corner (xyz distance)
    14341434                   DO  k = nzb_si + 1, nzb_si + vi
    1435                       l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1), &
    1436                                                SQRT( 0.25 * (dx**2 + dy**2) + &
    1437                                                ( zu(k) - zw(nzb_si) )**2 ) )
     1435                      l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1),              &
     1436                                            SQRT( 0.25_wp * (dx**2 + dy**2) + &
     1437                                            ( zu(k) - zw(nzb_si) )**2 ) )
    14381438                   ENDDO
    14391439                ENDIF
     
    14441444!--             South wall (y distance)
    14451445                DO  k = wall_s(j,i), nzb_si
    1446                    l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i), 0.5 * dy )
     1446                   l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i), 0.5_wp * dy )
    14471447                ENDDO
    14481448!
    14491449!--             Above south wall (yz distance)
    1450                 DO  k = nzb_si + 1, &
    1451                         nzb_si + vi
    1452                    l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i),     &
    1453                                           SQRT( 0.25 * dy**2 + &
     1450                DO  k = nzb_si + 1, nzb_si + vi
     1451                   l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i),                     &
     1452                                          SQRT( 0.25_wp * dy**2 +              &
    14541453                                          ( zu(k) - zw(nzb_si) )**2 ) )
    14551454                ENDDO
     
    14581457                IF ( corner_sl(j,i) > 0 )  THEN
    14591458                   DO  k = corner_sl(j,i), nzb_si
    1460                       l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1), &
    1461                                                0.5 * SQRT( dx**2 + dy**2 ) )
     1459                      l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1),              &
     1460                                               0.5_wp * SQRT( dx**2 + dy**2 ) )
    14621461                   ENDDO
    14631462!
    14641463!--                Above southleft corner (xyz distance)
    14651464                   DO  k = nzb_si + 1, nzb_si + vi
    1466                       l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1),             &
    1467                                                SQRT( 0.25 * (dx**2 + dy**2) + &
    1468                                                ( zu(k) - zw(nzb_si) )**2 ) )
     1465                      l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1),              &
     1466                                            SQRT( 0.25_wp * (dx**2 + dy**2) + &
     1467                                            ( zu(k) - zw(nzb_si) )**2 ) )
    14691468                   ENDDO
    14701469                ENDIF
     
    14731472                IF ( corner_sr(j,i) > 0 )  THEN
    14741473                   DO  k = corner_sr(j,i), nzb_si
    1475                       l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1), &
    1476                                                0.5 * SQRT( dx**2 + dy**2 ) )
     1474                      l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1),              &
     1475                                               0.5_wp * SQRT( dx**2 + dy**2 ) )
    14771476                   ENDDO
    14781477!
    14791478!--                Above southright corner (xyz distance)
    14801479                   DO  k = nzb_si + 1, nzb_si + vi
    1481                       l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1),             &
    1482                                                SQRT( 0.25 * (dx**2 + dy**2) + &
    1483                                                ( zu(k) - zw(nzb_si) )**2 ) )
     1480                      l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1),              &
     1481                                            SQRT( 0.25_wp * (dx**2 + dy**2) + &
     1482                                            ( zu(k) - zw(nzb_si) )**2 ) )
    14841483                   ENDDO
    14851484                ENDIF
     
    14911490!--             Left wall (x distance)
    14921491                DO  k = wall_l(j,i), nzb_si
    1493                    l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1), 0.5 * dx )
     1492                   l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1), 0.5_wp * dx )
    14941493                ENDDO
    14951494!
    14961495!--             Above left wall (xz distance)
    14971496                DO  k = nzb_si + 1, nzb_si + vi
    1498                    l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1),     &
    1499                                           SQRT( 0.25 * dx**2 + &
     1497                   l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1),                     &
     1498                                       SQRT( 0.25_wp * dx**2 +                 &
     1499                                       ( zu(k) - zw(nzb_si) )**2 ) )
     1500                ENDDO
     1501             ENDIF
     1502
     1503             IF ( wall_r(j,i) > 0 )  THEN
     1504!
     1505!--             Right wall (x distance)
     1506                DO  k = wall_r(j,i), nzb_si
     1507                   l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1), 0.5_wp * dx )
     1508                ENDDO
     1509!
     1510!--             Above right wall (xz distance)
     1511                DO  k = nzb_si + 1, nzb_si + vi
     1512                   l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1),                     &
     1513                                          SQRT( 0.25_wp * dx**2 +              &
    15001514                                          ( zu(k) - zw(nzb_si) )**2 ) )
    15011515                ENDDO
    1502              ENDIF
    1503 
    1504              IF ( wall_r(j,i) > 0 )  THEN
    1505 !
    1506 !--             Right wall (x distance)
    1507                 DO  k = wall_r(j,i), nzb_si
    1508                    l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1), 0.5 * dx )
    1509                 ENDDO
    1510 !
    1511 !--             Above right wall (xz distance)
    1512                 DO  k = nzb_si + 1, nzb_si + vi
    1513                    l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1),     &
    1514                                           SQRT( 0.25 * dx**2 + &
    1515                                           ( zu(k) - zw(nzb_si) )**2 ) )
    1516                 ENDDO
    15171516
    15181517             ENDIF
Note: See TracChangeset for help on using the changeset viewer.